import re
from random import shuffle, randint

dirs = [[1, 0], [0, 1], [1, 1], [1, -1], [-1, 0], [0, -1], [-1, -1], [-1, 1]]
n_rows = 10
n_cols = 10
grid_size = n_rows * n_cols
min_words = 25

class Grid:
    def __init__(self):
        self.num_attempts = 0
        self.cells = [['' for _ in range(n_cols)] for _ in range(n_rows)]
        self.solutions = []

def read_words(filename):
    max_len = max(n_rows, n_cols)

    words = []
    with open(filename, "r") as file:
        for line in file:
            s = line.strip().lower()
            if re.match(r'^[a-z]{3,' + re.escape(str(max_len)) + r'}$', s) is not None:
                words.append(s)

    return words

def place_message(grid, msg):
    msg = re.sub(r'[^A-Z]', "", msg.upper())

    message_len = len(msg)
    if 0 < message_len < grid_size:
        gap_size = grid_size // message_len

        for i in range(0, message_len):
            pos = i * gap_size + randint(0, gap_size)
            grid.cells[pos // n_cols][pos % n_cols] = msg[i]

        return message_len

    return 0

def try_location(grid, word, direction, pos):
    r = pos // n_cols
    c = pos % n_cols
    length = len(word)

    # check bounds
    if (dirs[direction][0] == 1 and (length + c) > n_cols) or \
       (dirs[direction][0] == -1 and (length - 1) > c) or \
       (dirs[direction][1] == 1 and (length + r) > n_rows) or \
       (dirs[direction][1] == -1 and (length - 1) > r):
        return 0

    rr = r
    cc = c
    i = 0
    overlaps = 0

    # check cells
    while i < length:
        if grid.cells[rr][cc] != '' and grid.cells[rr][cc] != word[i]:
            return 0
        cc += dirs[direction][0]
        rr += dirs[direction][1]
        i += 1

    rr = r
    cc = c
    i = 0
    # place
    while i < length:
        if grid.cells[rr][cc] == word[i]:
            overlaps += 1
        else:
            grid.cells[rr][cc] = word[i]

        if i < length - 1:
            cc += dirs[direction][0]
            rr += dirs[direction][1]

        i += 1

    letters_placed = length - overlaps
    if letters_placed > 0:
        grid.solutions.append("{0:<10} ({1},{2})({3},{4})".format(word, c, r, cc, rr))

    return letters_placed

def try_place_word(grid, word):
    rand_dir = randint(0, len(dirs))
    rand_pos = randint(0, grid_size)

    for direction in range(0, len(dirs)):
        direction = (direction + rand_dir) % len(dirs)

        for pos in range(0, grid_size):
            pos = (pos + rand_pos) % grid_size

            letters_placed = try_location(grid, word, direction, pos)
            if letters_placed > 0:
                return letters_placed

    return 0

def create_word_search(words):
    grid = None
    num_attempts = 0

    while num_attempts < 100:
        num_attempts += 1
        shuffle(words)

        grid = Grid()
        message_len = place_message(grid, "Rosetta Code")
        target = grid_size - message_len

        cells_filled = 0
        for word in words:
            cells_filled += try_place_word(grid, word)
            if cells_filled == target:
                if len(grid.solutions) >= min_words:
                    grid.num_attempts = num_attempts
                    return grid
                else:
                    break # grid is full but we didn't pack enough words, start over

    return grid

def print_result(grid):
    if grid is None or grid.num_attempts == 0:
        print("No grid to display")
        return

    size = len(grid.solutions)

    print("Attempts: {0}".format(grid.num_attempts))
    print("Number of words: {0}".format(size))

    print("\n     0  1  2  3  4  5  6  7  8  9\n")
    for r in range(0, n_rows):
        print("{0}   ".format(r), end='')
        for c in range(0, n_cols):
            print(" %c " % grid.cells[r][c], end='')
        print()
    print()

    for i in range(0, size - 1, 2):
        print("{0}   {1}".format(grid.solutions[i], grid.solutions[i+1]))

    if size % 2 == 1:
        print(grid.solutions[size - 1])

if __name__ == "__main__":
    print_result(create_word_search(read_words("unixdict.txt")))


    OPTION _EXPLICIT
    _TITLE "Puzzle Builder for Rosetta" 'by B+ started 2018-10-31
    ' 2018-11-02 Now that puzzle is working with basic and plus starters remove them and make sure puzzle works as well.
    ' Added Direction legend to printout.
    ' OverHauled LengthLimit()
    ' Reorgnize this to try a couple of times at given Randomize number
    ' TODO create alphabetical copy of word list and check grid for all words embedded in it.
    ' LoadWords makes a copy of word list in alpha order
    ' FindAllWords finds all the items from the dictionary
    ' OK it all seems to be working OK

    RANDOMIZE TIMER ' OK getting a good puzzle every time

    'overhauled
    DIM SHARED LengthLimit(3 TO 10) AS _BYTE 'reset in Initialize, track and limit longer words

    'LoadWords opens file of words and sets
    DIM SHARED NWORDS 'set in LoadWords, number of words with length: > 2 and < 11  and just letters

    ' word file words (shuffled) to be fit into puzzle and index position
    DIM SHARED WORDS$(1 TO 24945), CWORDS$(1 TO 24945), WORDSINDEX AS INTEGER 'the file has 24945 words but many are unsuitable

    'words placed in Letters grid, word itself (W$) x, y head (WX, WY) and direction (WD), WI is the index to all these
    DIM SHARED W$(1 TO 100), WX(1 TO 100) AS _BYTE, WY(1 TO 100) AS _BYTE, WD(1 TO 100) AS _BYTE, WI AS _BYTE

    ' letters grid and direction arrays
    DIM SHARED L$(0 TO 9, 0 TO 9), DX(0 TO 7) AS _BYTE, DY(0 TO 7) AS _BYTE
    DX(0) = 1: DY(0) = 0
    DX(1) = 1: DY(1) = 1
    DX(2) = 0: DY(2) = 1
    DX(3) = -1: DY(3) = 1
    DX(4) = -1: DY(4) = 0
    DX(5) = -1: DY(5) = -1
    DX(6) = 0: DY(6) = -1
    DX(7) = 1: DY(7) = -1

    'to store all the words found embedded in the grid L$()
    DIM SHARED ALL$(1 TO 200), AllX(1 TO 200) AS _BYTE, AllY(1 TO 200) AS _BYTE, AllD(1 TO 200) AS _BYTE 'to store all the words found embedded in the grid L$()
    DIM SHARED ALLindex AS INTEGER

    ' signal successful fill of puzzle
    DIM SHARED FILLED AS _BIT
    FILLED = 0
    DIM try AS _BYTE
    try = 1
    LoadWords 'this sets NWORDS count to work with
    WHILE try < 11
        Initialize
        ShowPuzzle
        FOR WORDSINDEX = 1 TO NWORDS
            PlaceWord
            ShowPuzzle
            IF FILLED THEN EXIT FOR
        NEXT
        IF FILLED AND WI > 24 THEN
            FindAllWords
            FilePuzzle
            LOCATE 23, 1: PRINT "On try #"; Trm$(try); " a successful puzzle was built and filed."
            EXIT WHILE
        ELSE
            try = try + 1
        END IF
    WEND
    IF FILLED = 0 THEN LOCATE 23, 1: PRINT "Sorry, 10 tries and no success."
    END

    SUB LoadWords
        DIM wd$, i AS INTEGER, m AS INTEGER, ok AS _BIT
        OPEN "unixdict.txt" FOR INPUT AS #1
        WHILE EOF(1) = 0
            INPUT #1, wd$
            IF LEN(wd$) > 2 AND LEN(wd$) < 11 THEN
                ok = -1
                FOR m = 1 TO LEN(wd$)
                    IF ASC(wd$, m) < 97 OR ASC(wd$, m) > 122 THEN ok = 0: EXIT FOR
                NEXT
                IF ok THEN i = i + 1: WORDS$(i) = wd$: CWORDS$(i) = wd$
            END IF
        WEND
        CLOSE #1
        NWORDS = i
    END SUB

    SUB Shuffle
        DIM i AS INTEGER, r AS INTEGER
        FOR i = NWORDS TO 2 STEP -1
            r = INT(RND * i) + 1
            SWAP WORDS$(i), WORDS$(r)
        NEXT
    END SUB

    SUB Initialize
        DIM r AS _BYTE, c AS _BYTE, x AS _BYTE, y AS _BYTE, d AS _BYTE, wd$
        FOR r = 0 TO 9
            FOR c = 0 TO 9
                L$(c, r) = " "
            NEXT
        NEXT

        'reset word arrays by resetting the word index back to zero
        WI = 0

        'fun stuff for me but doubt others would like that much fun!
        'pluggin "basic", 0, 0, 2
        'pluggin "plus", 1, 0, 0

        'to assure the spreading of ROSETTA CODE
        L$(INT(RND * 5) + 5, 0) = "R": L$(INT(RND * 9) + 1, 1) = "O"
        L$(INT(RND * 9) + 1, 2) = "S": L$(INT(RND * 9) + 1, 3) = "E"
        L$(1, 4) = "T": L$(9, 4) = "T": L$(INT(10 * RND), 5) = "A"
        L$(INT(10 * RND), 6) = "C": L$(INT(10 * RND), 7) = "O"
        L$(INT(10 * RND), 8) = "D": L$(INT(10 * RND), 9) = "E"

        'reset limits
        LengthLimit(3) = 200
        LengthLimit(4) = 6
        LengthLimit(5) = 3
        LengthLimit(6) = 2
        LengthLimit(7) = 1
        LengthLimit(8) = 0
        LengthLimit(9) = 0
        LengthLimit(10) = 0

        'reset word order
        Shuffle
    END SUB

    'for fun plug-in of words
    SUB pluggin (wd$, x AS INTEGER, y AS INTEGER, d AS INTEGER)
        DIM i AS _BYTE
        FOR i = 0 TO LEN(wd$) - 1
            L$(x + i * DX(d), y + i * DY(d)) = MID$(wd$, i + 1, 1)
        NEXT
        WI = WI + 1
        W$(WI) = wd$: WX(WI) = x: WY(WI) = y: WD(WI) = d
    END SUB

    FUNCTION Trm$ (n AS INTEGER)
        Trm$ = RTRIM$(LTRIM$(STR$(n)))
    END FUNCTION

    SUB ShowPuzzle
        DIM i AS _BYTE, x AS _BYTE, y AS _BYTE, wate$
        CLS
        PRINT "    0 1 2 3 4 5 6 7 8 9"
        LOCATE 3, 1
        FOR i = 0 TO 9
            PRINT Trm$(i)
        NEXT
        FOR y = 0 TO 9
            FOR x = 0 TO 9
                LOCATE y + 3, 2 * x + 5: PRINT L$(x, y)
            NEXT
        NEXT
        FOR i = 1 TO WI
            IF i < 20 THEN
                LOCATE i + 1, 30: PRINT Trm$(i); " "; W$(i)
            ELSEIF i < 40 THEN
                LOCATE i - 20 + 1, 45: PRINT Trm$(i); " "; W$(i)
            ELSEIF i < 60 THEN
                LOCATE i - 40 + 1, 60: PRINT Trm$(i); " "; W$(i)
            END IF
        NEXT
        LOCATE 18, 1: PRINT "Spaces left:"; CountSpaces%
        LOCATE 19, 1: PRINT NWORDS
        LOCATE 20, 1: PRINT SPACE$(16)
        IF WORDSINDEX THEN LOCATE 20, 1: PRINT Trm$(WORDSINDEX); " "; WORDS$(WORDSINDEX)
        'LOCATE 15, 1: INPUT "OK, press enter... "; wate$
    END SUB

    'used in PlaceWord
    FUNCTION CountSpaces% ()
        DIM x AS _BYTE, y AS _BYTE, count AS INTEGER
        FOR y = 0 TO 9
            FOR x = 0 TO 9
                IF L$(x, y) = " " THEN count = count + 1
            NEXT
        NEXT
        CountSpaces% = count
    END FUNCTION

    'used in PlaceWord
    FUNCTION Match% (word AS STRING, template AS STRING)
        DIM i AS INTEGER, c AS STRING
        Match% = 0
        IF LEN(word) <> LEN(template) THEN EXIT FUNCTION
        FOR i = 1 TO LEN(template)
            IF ASC(template, i) <> 32 AND (ASC(word, i) <> ASC(template, i)) THEN EXIT FUNCTION
        NEXT
        Match% = -1
    END FUNCTION

    'heart of puzzle builder
    SUB PlaceWord
        ' place the words randomly in the grid
        ' start at random spot and work forward or back 100 times = all the squares
        ' for each open square try the 8 directions for placing the word
        ' even if word fits Rossetta Challenge task requires leaving 11 openings to insert ROSETTA CODE,
        ' exactly 11 spaces needs to be left, if/when this occurs FILLED will be set true to signal finished to main loop
        ' if place a word update L$, WI, W$(WI), WX(WI), WY(WI), WD(WI)

        DIM wd$, wLen AS _BYTE, spot AS _BYTE, testNum AS _BYTE, rdir AS _BYTE
        DIM x AS _BYTE, y AS _BYTE, d AS _BYTE, dNum AS _BYTE, rdd AS _BYTE
        DIM template$, b1 AS _BIT, b2 AS _BIT
        DIM i AS _BYTE, j AS _BYTE, wate$

        wd$ = WORDS$(WORDSINDEX) 'the right side is all shared
        'skip too many long words
        IF LengthLimit(LEN(wd$)) THEN LengthLimit(LEN(wd$)) = LengthLimit(LEN(wd$)) - 1 ELSE EXIT SUB 'skip long ones
        wLen = LEN(wd$) - 1 '     from the spot there are this many letters to check
        spot = INT(RND * 100) '   a random spot on grid
        testNum = 1 '             when this hits 100 we've tested all possible spots on grid
        IF RND < .5 THEN rdir = -1 ELSE rdir = 1 ' go forward or back from spot for next test
        WHILE testNum < 101
            y = INT(spot / 10)
            x = spot MOD 10
            IF L$(x, y) = MID$(wd$, 1, 1) OR L$(x, y) = " " THEN
                d = INT(8 * RND)
                IF RND < .5 THEN rdd = -1 ELSE rdd = 1
                dNum = 1
                WHILE dNum < 9
                    'will wd$ fit? from  at x, y
                    template$ = ""
                    b1 = wLen * DX(d) + x >= 0 AND wLen * DX(d) + x <= 9
                    b2 = wLen * DY(d) + y >= 0 AND wLen * DY(d) + y <= 9
                    IF b1 AND b2 THEN 'build the template of letters and spaces from Letter grid
                        FOR i = 0 TO wLen
                            template$ = template$ + L$(x + i * DX(d), y + i * DY(d))
                        NEXT
                        IF Match%(wd$, template$) THEN 'the word will fit but does it fill anything?
                            FOR j = 1 TO LEN(template$)
                                IF ASC(template$, j) = 32 THEN 'yes a space to fill
                                    FOR i = 0 TO wLen
                                        L$(x + i * DX(d), y + i * DY(d)) = MID$(wd$, i + 1, 1)
                                    NEXT
                                    WI = WI + 1
                                    W$(WI) = wd$: WX(WI) = x: WY(WI) = y: WD(WI) = d
                                    IF CountSpaces% = 0 THEN FILLED = -1
                                    EXIT SUB 'get out now that word is loaded
                                END IF
                            NEXT
                            'if still here keep looking
                        END IF
                    END IF
                    d = (d + 8 + rdd) MOD 8
                    dNum = dNum + 1
                WEND
            END IF
            spot = (spot + 100 + rdir) MOD 100
            testNum = testNum + 1
        WEND
    END SUB

    SUB FindAllWords
        DIM wd$, wLen AS _BYTE, i AS INTEGER, x AS _BYTE, y AS _BYTE, d AS _BYTE
        DIM template$, b1 AS _BIT, b2 AS _BIT, j AS _BYTE, wate$

        FOR i = 1 TO NWORDS
            wd$ = CWORDS$(i)
            wLen = LEN(wd$) - 1
            FOR y = 0 TO 9
                FOR x = 0 TO 9
                    IF L$(x, y) = MID$(wd$, 1, 1) THEN
                        FOR d = 0 TO 7
                            b1 = wLen * DX(d) + x >= 0 AND wLen * DX(d) + x <= 9
                            b2 = wLen * DY(d) + y >= 0 AND wLen * DY(d) + y <= 9
                            IF b1 AND b2 THEN 'build the template of letters and spaces from Letter grid
                                template$ = ""
                                FOR j = 0 TO wLen
                                    template$ = template$ + L$(x + j * DX(d), y + j * DY(d))
                                NEXT
                                IF template$ = wd$ THEN 'founda word
                                    'store it
                                    ALLindex = ALLindex + 1
                                    ALL$(ALLindex) = wd$: AllX(ALLindex) = x: AllY(ALLindex) = y: AllD(ALLindex) = d
                                    'report it
                                    LOCATE 22, 1: PRINT SPACE$(50)
                                    LOCATE 22, 1: PRINT "Found: "; wd$; " ("; Trm$(x); ", "; Trm$(y); ") >>>---> "; Trm$(d);
                                    INPUT " Press enter...", wate$
                                END IF
                            END IF
                        NEXT d
                    END IF
                NEXT x
            NEXT y
        NEXT i
    END SUB

    SUB FilePuzzle
        DIM i AS _BYTE, r AS _BYTE, c AS _BYTE, b$
        OPEN "WS Puzzle.txt" FOR OUTPUT AS #1
        PRINT #1, "    0 1 2 3 4 5 6 7 8 9"
        PRINT #1, ""
        FOR r = 0 TO 9
            b$ = Trm$(r) + "   "
            FOR c = 0 TO 9
                b$ = b$ + L$(c, r) + " "
            NEXT
            PRINT #1, b$
        NEXT
        PRINT #1, ""
        PRINT #1, "Directions >>>---> 0 = East, 1 = SE, 2 = South, 3 = SW, 4 = West, 5 = NW, 6 = North, 7 = NE"
        PRINT #1, ""
        PRINT #1, "              These are the items from unixdict.txt used to build the puzzle:"
        PRINT #1, ""
        FOR i = 1 TO WI STEP 2
            PRINT #1, RIGHT$(SPACE$(7) + Trm$(i), 7); ") "; RIGHT$(SPACE$(7) + W$(i), 10); " ("; Trm$(WX(i)); ", "; Trm$(WY(i)); ") >>>---> "; Trm$(WD(i));
            IF i + 1 <= WI THEN
                PRINT #1, RIGHT$(SPACE$(7) + Trm$(i + 1), 7); ") "; RIGHT$(SPACE$(7) + W$(i + 1), 10); " ("; Trm$(WX(i + 1)); ", "; Trm$(WY(i + 1)); ") >>>---> "; Trm$(WD(i + 1))
            ELSE
                PRINT #1, ""
            END IF
        NEXT
        PRINT #1, ""
        PRINT #1, "            These are the items from unixdict.txt found embedded in the puzzle:"
        PRINT #1, ""
        FOR i = 1 TO ALLindex STEP 2
            PRINT #1, RIGHT$(SPACE$(7) + Trm$(i), 7); ") "; RIGHT$(SPACE$(7) + ALL$(i), 10); " ("; Trm$(AllX(i)); ", "; Trm$(AllY(i)); ") >>>---> "; Trm$(AllD(i));
            IF i + 1 <= ALLindex THEN
                PRINT #1, RIGHT$(SPACE$(7) + Trm$(i + 1), 7); ") "; RIGHT$(SPACE$(7) + ALL$(i + 1), 10); " ("; Trm$(AllX(i + 1)); ", "; Trm$(AllY(i + 1)); ") >>>---> "; Trm$(AllD(i + 1))
            ELSE
                PRINT #1, ""
            END IF
        NEXT
        CLOSE #1
    END SUB


#lang racket
;; ---------------------------------------------------------------------------------------------------
(module+ main
  (display-puzzle (create-word-search))
  (newline)
  (parameterize ((current-min-words 50))
    (display-puzzle (create-word-search #:n-rows 20 #:n-cols 20))))

;; ---------------------------------------------------------------------------------------------------
(define current-min-words (make-parameter 25))

;; ---------------------------------------------------------------------------------------------------
(define (all-words pzl)
  (filter-map (good-word? pzl) (file->lines "data/unixdict.txt")))

(define (good-word? pzl)
  (let ((m (puzzle-max-word-size pzl)))
    (λ (w) (and (<= 3 (string-length w) m) (regexp-match #px"^[A-Za-z]*$" w) (string-downcase w)))))

(struct puzzle (n-rows n-cols cells solutions) #:transparent)

(define puzzle-max-word-size (match-lambda [(puzzle n-rows n-cols _ _) (max n-rows n-cols)]))

(define dirs '((-1 -1 ↖) (-1 0 ↑) (-1 1 ↗) (0 -1 ←) (0 1 →) (1 -1 ↙) (1 0 ↓) (1 1 ↘)))

;; ---------------------------------------------------------------------------------------------------
(define (display-puzzle pzl) (displayln (puzzle->string pzl)))

(define (puzzle->string pzl)
  (match-let*
      (((and pzl (puzzle n-rows n-cols cells (and solutions (app length size)))) pzl)
       (column-numbers (cons "" (range n-cols)))
       (render-row (λ (r) (cons r (map (λ (c) (hash-ref cells (cons r c) #\_)) (range n-cols)))))
       (the-grid (add-between (map (curry map (curry ~a #:width 3))
                                   (cons column-numbers (map render-row (range n-rows)))) "\n"))
       (solutions§ (solutions->string (sort solutions string<? #:key car))))
    (string-join (flatten (list the-grid "\n\n" solutions§)) "")))

(define (solutions->string solutions)
  (let* ((l1 (compose string-length car))
         (format-solution-to-max-word-size (format-solution (l1 (argmax l1 solutions)))))
    (let recur ((solutions solutions) (need-newline? #f) (acc null))
      (if (null? solutions)
          (reverse (if need-newline? (cons "\n" acc) acc))
          (let* ((spacer (if need-newline? "\n" "   "))
                 (solution (format "~a~a" (format-solution-to-max-word-size (car solutions)) spacer)))
            (recur (cdr solutions) (not need-newline?) (cons solution acc)))))))

(define (format-solution max-word-size)
  (match-lambda [(list word row col dir)
                 (string-append (~a word #:width (+ max-word-size 1))
                                (~a (format "(~a,~a ~a)" row col dir) #:width 9))]))

;; ---------------------------------------------------------------------------------------------------
(define (create-word-search #:msg (msg "Rosetta Code") #:n-rows (n-rows 10) #:n-cols (n-cols 10))
  (let* ((pzl (puzzle n-rows n-cols (hash) null))
         (MSG (sanitise-message msg))
         (n-holes (- (* n-rows n-cols) (string-length MSG))))
    (place-message (place-words pzl (shuffle (all-words pzl)) (current-min-words) n-holes) MSG)))

(define (sanitise-message msg) (regexp-replace* #rx"[^A-Z]" (string-upcase msg) ""))

(define (place-words pzl words needed-words holes)
  (let inner ((pzl pzl) (words words) (needed-words needed-words) (holes holes))
    (cond [(and (not (positive? needed-words)) (zero? holes)) pzl]
          [(null? words)
           (eprintf "no solution... retrying (~a words remaining)~%" needed-words)
           (inner pzl (shuffle words) needed-words)]
          [else
           (let/ec no-fit
             (let*-values
                 (([word words...] (values (car words) (cdr words)))
                  ([solution cells′ holes′]
                   (fit-word word pzl holes (λ () (no-fit (inner pzl words... needed-words holes)))))
                  ([solutions′] (cons solution (puzzle-solutions pzl)))
                  ([pzl′] (struct-copy puzzle pzl (solutions solutions′) (cells cells′))))
               (inner pzl′ words... (sub1 needed-words) holes′)))])))

(define (fit-word word pzl holes fail)
  (match-let* (((puzzle n-rows n-cols cells _) pzl)
               (rows (shuffle (range n-rows)))
               (cols (shuffle (range n-cols)))
               (fits? (let ((l (string-length word))) (λ (maxz z0 dz) (< -1 (+ z0 (* dz l)) maxz)))))
    (let/ec return
      (for* ((dr-dc-↗ (shuffle dirs))
             (r0 rows) (dr (in-value (car dr-dc-↗))) #:when (fits? n-rows r0 dr)
             (c0 cols) (dc (in-value (cadr dr-dc-↗))) #:when (fits? n-cols c0 dc)
             (↗ (in-value (caddr dr-dc-↗))))
        (let/ec retry/ec (attempt-word-fit pzl word r0 c0 dr dc ↗ holes return retry/ec)))
      (fail))))

(define (attempt-word-fit pzl word r0 c0 dr dc ↗ holes return retry)
  (let-values (([cells′ available-cells′]
                (for/fold ((cells′ (puzzle-cells pzl)) (holes′ holes))
                          ((w word) (i (in-naturals)))
                  (define k (cons (+ r0 (* dr i)) (+ c0 (* dc i))))
                  (cond [(not (hash-has-key? cells′ k))
                         (if (zero? holes′) (retry) (values (hash-set cells′ k w) (sub1 holes′)))]
                        [(char=? (hash-ref cells′ k) w) (values cells′ holes′)]
                        [else (retry)]))))
    (return (list word r0 c0 ↗) cells′ available-cells′)))

;; ---------------------------------------------------------------------------------------------------
(define (place-message pzl MSG)
  (match-define (puzzle n-rows n-cols cells _) pzl)
  (struct-copy puzzle pzl
               (cells
                (let loop ((r 0) (c 0) (cells cells) (msg (string->list MSG)))
                  (cond [(or (null? msg) (= r n-rows)) cells]
                        [(= c n-cols) (loop (add1 r) 0 cells msg)]
                        [(hash-has-key? cells (cons r c)) (loop r (add1 c) cells msg)]
                        [else (loop r (add1 c) (hash-set cells (cons r c) (car msg)) (cdr msg))])))))


my $rows = 10;
my $cols = 10;

my $message = q:to/END/;
    .....R....
    ......O...
    .......S..
    ........E.
    T........T
    .A........
    ..C.......
    ...O......
    ....D.....
    .....E....
    END

my %dir =
    '→' => (1,0),
    '↘' => (1,1),
    '↓' => (0,1),
    '↙' => (-1,1),
    '←' => (-1,0),
    '↖' => (-1,-1),
    '↑' => (0,-1),
    '↗' => (1,-1)
;

my @ws = $message.comb(/<print>/);

my $path = './unixdict.txt'; # or wherever

my @words = $path.IO.slurp.words.grep( { $_ !~~ /<-[a..z]>/ and 2 < .chars < 11 } ).pick(*);
my %index;
my %used;

while @ws.first( * eq '.') {

    # find an unfilled cell
    my $i = @ws.grep( * eq '.', :k ).pick;

    # translate the index to x / y coordinates
    my ($x, $y) = $i % $cols, floor($i / $rows);

    # find a word that fits
    my $word = find($x, $y);

    # Meh, reached an impasse, easier to just throw it all
    # away and start over rather than trying to backtrack.
    restart, next unless $word;

    %used{"$word"}++;

    # Keeps trying to place an already used word, choices
    # must be limited, start over
    restart, next if %used{$word} > 15;

    # Already used this word, try again
    next if %index{$word.key};

    # Add word to used word index
    %index ,= $word;

    # place the word into the grid
    place($x, $y, $word);

}

display();

sub display {
    put flat "    ", 'ABCDEFGHIJ'.comb;
    .put for (^10).map: { ($_).fmt("  %2d"), @ws[$_ * $cols .. ($_ + 1) * $cols - 1] }
    put "\n  Words used:";
    my $max = 1 + %index.keys.max( *.chars ).chars;
    for %index.sort {
        printf "%{$max}s %4s %s  ", .key, .value.key, .value.value;
        print "\n" if $++ % 2;
    }
    say "\n"
}

sub restart {
    @ws = $message.comb(/<print>/);
    %index = ();
    %used = ();
}

sub place ($x is copy, $y is copy, $w) {
    my @word = $w.key.comb;
    my $dir  = %dir{$w.value.value};
    @ws[$y * $rows + $x] = @word.shift;
    while @word {
        ($x, $y) »+=« $dir;
        @ws[$y * $rows + $x] = @word.shift;
    }
 }

sub find ($x, $y) {
    my @trials = %dir.keys.map: -> $dir {
            my $space = '.';
            my ($c, $r) = $x, $y;
            loop {
                ($c, $r) »+=« %dir{$dir};
                last if 9 < $r|$c;
                last if 0 > $r|$c;
                my $l = @ws[$r * $rows + $c];
                last if $l ~~ /<:Lu>/;
                $space ~= $l;
            }
            next if $space.chars < 3;
            [$space.trans( '.' => ' ' ),
            ("{'ABCDEFGHIJ'.comb[$x]} {$y}" => $dir)]
        };

    for @words.pick(*) -> $word {
        for @trials -> $space {
            next if $word.chars > $space[0].chars;
            return ($word => $space[1]) if compare($space[0].comb, $word.comb)
        }
    }
}

sub compare (@s, @w) {
    for ^@w {
        next if @s[$_] eq ' ';
        return False if @s[$_] ne @w[$_]
    }
    True
}


Module Module1

    ReadOnly Dirs As Integer(,) = {
        {1, 0}, {0, 1}, {1, 1},
        {1, -1}, {-1, 0},
        {0, -1}, {-1, -1}, {-1, 1}
    }

    Const RowCount = 10
    Const ColCount = 10
    Const GridSize = RowCount * ColCount
    Const MinWords = 25

    Class Grid
        Public cells(RowCount - 1, ColCount - 1) As Char
        Public solutions As New List(Of String)
        Public numAttempts As Integer

        Sub New()
            For i = 0 To RowCount - 1
                For j = 0 To ColCount - 1
                    cells(i, j) = ControlChars.NullChar
                Next
            Next
        End Sub
    End Class

    Dim Rand As New Random()

    Sub Main()
        PrintResult(CreateWordSearch(ReadWords("unixdict.txt")))
    End Sub

    Function ReadWords(filename As String) As List(Of String)
        Dim maxlen = Math.Max(RowCount, ColCount)
        Dim words As New List(Of String)

        Dim objReader As New IO.StreamReader(filename)
        Dim line As String
        Do While objReader.Peek() <> -1
            line = objReader.ReadLine()
            If line.Length > 3 And line.Length < maxlen Then
                If line.All(Function(c) Char.IsLetter(c)) Then
                    words.Add(line)
                End If
            End If
        Loop

        Return words
    End Function

    Function CreateWordSearch(words As List(Of String)) As Grid
        For numAttempts = 1 To 1000
            Shuffle(words)

            Dim grid As New Grid()
            Dim messageLen = PlaceMessage(grid, "Rosetta Code")
            Dim target = GridSize - messageLen

            Dim cellsFilled = 0
            For Each word In words
                cellsFilled = cellsFilled + TryPlaceWord(grid, word)
                If cellsFilled = target Then
                    If grid.solutions.Count >= MinWords Then
                        grid.numAttempts = numAttempts
                        Return grid
                    Else
                        'grid is full but we didn't pack enough words, start over
                        Exit For
                    End If
                End If
            Next
        Next

        Return Nothing
    End Function

    Function PlaceMessage(grid As Grid, msg As String) As Integer
        msg = msg.ToUpper()
        msg = msg.Replace(" ", "")

        If msg.Length > 0 And msg.Length < GridSize Then
            Dim gapSize As Integer = GridSize / msg.Length

            Dim pos = 0
            Dim lastPos = -1
            For i = 0 To msg.Length - 1
                If i = 0 Then
                    pos = pos + Rand.Next(gapSize - 1)
                Else
                    pos = pos + Rand.Next(2, gapSize - 1)
                End If
                Dim r As Integer = Math.Floor(pos / ColCount)
                Dim c = pos Mod ColCount

                grid.cells(r, c) = msg(i)

                lastPos = pos
            Next
            Return msg.Length
        End If

        Return 0
    End Function

    Function TryPlaceWord(grid As Grid, word As String) As Integer
        Dim randDir = Rand.Next(Dirs.GetLength(0))
        Dim randPos = Rand.Next(GridSize)

        For d = 0 To Dirs.GetLength(0) - 1
            Dim dd = (d + randDir) Mod Dirs.GetLength(0)

            For p = 0 To GridSize - 1
                Dim pp = (p + randPos) Mod GridSize

                Dim lettersPLaced = TryLocation(grid, word, dd, pp)
                If lettersPLaced > 0 Then
                    Return lettersPLaced
                End If
            Next
        Next

        Return 0
    End Function

    Function TryLocation(grid As Grid, word As String, dir As Integer, pos As Integer) As Integer
        Dim r As Integer = pos / ColCount
        Dim c = pos Mod ColCount
        Dim len = word.Length

        'check bounds
        If (Dirs(dir, 0) = 1 And len + c >= ColCount) Or (Dirs(dir, 0) = -1 And len - 1 > c) Or (Dirs(dir, 1) = 1 And len + r >= RowCount) Or (Dirs(dir, 1) = -1 And len - 1 > r) Then
            Return 0
        End If
        If r = RowCount OrElse c = ColCount Then
            Return 0
        End If

        Dim rr = r
        Dim cc = c

        'check cells
        For i = 0 To len - 1
            If grid.cells(rr, cc) <> ControlChars.NullChar AndAlso grid.cells(rr, cc) <> word(i) Then
                Return 0
            End If

            cc = cc + Dirs(dir, 0)
            rr = rr + Dirs(dir, 1)
        Next

        'place
        Dim overlaps = 0
        rr = r
        cc = c
        For i = 0 To len - 1
            If grid.cells(rr, cc) = word(i) Then
                overlaps = overlaps + 1
            Else
                grid.cells(rr, cc) = word(i)
            End If

            If i < len - 1 Then
                cc = cc + Dirs(dir, 0)
                rr = rr + Dirs(dir, 1)
            End If
        Next

        Dim lettersPlaced = len - overlaps
        If lettersPlaced > 0 Then
            grid.solutions.Add(String.Format("{0,-10} ({1},{2})({3},{4})", word, c, r, cc, rr))
        End If

        Return lettersPlaced
    End Function

    Sub PrintResult(grid As Grid)
        If IsNothing(grid) OrElse grid.numAttempts = 0 Then
            Console.WriteLine("No grid to display")
            Return
        End If

        Console.WriteLine("Attempts: {0}", grid.numAttempts)
        Console.WriteLine("Number of words: {0}", GridSize)
        Console.WriteLine()

        Console.WriteLine("     0  1  2  3  4  5  6  7  8  9")
        For r = 0 To RowCount - 1
            Console.WriteLine()
            Console.Write("{0}   ", r)
            For c = 0 To ColCount - 1
                Console.Write(" {0} ", grid.cells(r, c))
            Next
        Next

        Console.WriteLine()
        Console.WriteLine()

        For i = 0 To grid.solutions.Count - 1
            If i Mod 2 = 0 Then
                Console.Write("{0}", grid.solutions(i))
            Else
                Console.WriteLine("   {0}", grid.solutions(i))
            End If
        Next

        Console.WriteLine()
    End Sub

    'taken from https://stackoverflow.com/a/20449161
    Sub Shuffle(Of T)(list As IList(Of T))
        Dim r As Random = New Random()
        For i = 0 To list.Count - 1
            Dim index As Integer = r.Next(i, list.Count)
            If i <> index Then
                ' swap list(i) and list(index)
                Dim temp As T = list(i)
                list(i) = list(index)
                list(index) = temp
            End If
        Next
    End Sub

End Module


import "random" for Random
import "/ioutil" for FileUtil
import "/pattern" for Pattern
import "/str" for Str
import "/fmt" for Fmt

var dirs = [ [1, 0], [0, 1], [1, 1], [1, -1], [-1, 0], [0, -1], [-1, -1], [-1,  1] ]
var Rows = 10
var Cols = 10
var gridSize = Rows * Cols
var minWords = 25
var rand = Random.new()

class Grid {
    construct new() {
        _numAttempts = 0
        _cells = List.filled(Rows, null)
        for (i in 0...Rows) _cells[i] = List.filled(Cols, " ")
        _solutions = []
    }

    numAttempts     { _numAttempts }
    numAttempts=(n) { _numAttempts = n }
    cells           { _cells }
    solutions       { _solutions }
}

var readWords = Fn.new { |fileName|
    var maxLen = Rows.max(Cols)
    var p = Pattern.new("=3/l#0%(maxLen-3)/l", Pattern.whole)
    return FileUtil.readLines(fileName)
                 .map   { |l| Str.lower(l.trim()) }
                 .where { |l| p.isMatch(l) }.toList
}

var placeMessage = Fn.new { |grid, msg|
    var p = Pattern.new("/U")
    var msg2 = p.replaceAll(Str.upper(msg), "")
    var messageLen = msg2.count
    if (messageLen >= 1 && messageLen < gridSize) {
        var gapSize = (gridSize / messageLen).floor
        for (i in 0...messageLen) {
            var pos = i * gapSize + rand.int(gapSize)
            grid.cells[(pos / Cols).floor][pos % Cols] = msg2[i]
        }
        return messageLen
    }
    return 0
}

var tryLocation = Fn.new { |grid, word, dir, pos|
    var r = (pos / Cols).floor
    var c = pos % Cols
    var len = word.count

    // check bounds
    if ((dirs[dir][0] == 1 && (len + c) > Cols)  ||
        (dirs[dir][0] == -1 && (len - 1) > c)    ||
        (dirs[dir][1] ==  1 && (len + r) > Rows) ||
        (dirs[dir][1] == -1 && (len - 1) > r)) return 0
    var overlaps = 0

    // check cells
    var rr = r
    var cc = c
    for (i in 0...len) {
        if (grid.cells[rr][cc] != " " && grid.cells[rr][cc] != word[i]) return 0
        cc = cc + dirs[dir][0]
        rr = rr + dirs[dir][1]
    }

    // place
    rr = r
    cc = c
    for (i in 0...len) {
        if (grid.cells[rr][cc] == word[i]) {
            overlaps = overlaps + 1
        } else {
            grid.cells[rr][cc] = word[i]
        }
        if (i < len - 1) {
            cc = cc + dirs[dir][0]
            rr = rr + dirs[dir][1]
        }
    }

    var lettersPlaced = len - overlaps
    if (lettersPlaced > 0) {
        grid.solutions.add(Fmt.swrite("$-10s ($d,$d)($d,$d)", word, c, r, cc, rr))
    }
    return lettersPlaced
}

var tryPlaceWord = Fn.new { |grid, word|
    var randDir = rand.int(dirs.count)
    var randPos = rand.int(gridSize)
    for (d in 0...dirs.count) {
        var dir = (d + randDir) % dirs.count
        for (p in 0...gridSize) {
            var pos = (p + randPos) % gridSize
            var lettersPlaced = tryLocation.call(grid, word, dir, pos)
            if (lettersPlaced > 0) return lettersPlaced
        }
    }
    return 0
}

var createWordSearch = Fn.new { |words|
    var numAttempts = 1
    var grid
    while (numAttempts < 100) {
        var outer = false
        grid = Grid.new()
        var messageLen = placeMessage.call(grid, "Rosetta Code")
        var target = gridSize - messageLen
        var cellsFilled = 0
        rand.shuffle(words)
        for (word in words) {
            cellsFilled = cellsFilled + tryPlaceWord.call(grid, word)
            if (cellsFilled == target) {
                if (grid.solutions.count >= minWords) {
                    grid.numAttempts = numAttempts
                    outer = true
                    break
                }
                // grid is full but we didn't pack enough words, start over
                break
            }
        }
        if (outer) break
        numAttempts = numAttempts + 1
    }
    return grid
}

var printResult = Fn.new { |grid|
    if (grid.numAttempts == 0) {
        System.print("No grid to display")
        return
    }
    var size = grid.solutions.count
    System.print("Attempts: %(grid.numAttempts)")
    System.print("Number of words: %(size)")
    System.print("\n     0  1  2  3  4  5  6  7  8  9")
    for (r in 0...Rows) {
         System.write("\n%(r)   ")
         for (c in 0...Cols) System.write(" %(grid.cells[r][c]) ")
    }
    System.print("\n")
    var i = 0
    while (i < size - 1) {
        System.print("%(grid.solutions[i])   %(grid.solutions[i + 1])")
        i = i + 2
    }
    if (size % 2 == 1) System.print(grid.solutions[size - 1])
}

printResult.call(createWordSearch.call(readWords.call("unixdict.txt")))


fcn buildVectors(R,C){  //-->up to 8 vectors of wild card strings
   var [const] dirs=T(T(1,0), T(0,1), T(1,1), T(1,-1), T(-1,0),T(0,-1), T(-1,-1), T(-1,1));
   vs,v:=List(),List();
   foreach dr,dc in (dirs){ v.clear(); r,c:=R,C;
      while( (0<=r<10) and (0<=c<10) ){ v.append(grid[r][c]); r+=dr; c+=dc; }
      vs.append(T(v.concat(), // eg "???e??????" would match "cohen" or "mineral"
      	dr,dc));
   }
   vs.filter(fcn(v){ v[0].len()>2 }).shuffle()
}
fcn findFit(vs,words){ //-->(n, word) ie (nth vector,word), empty vs not seen
   do(1000){ foreach n,v in (vs.enumerate()){ do(10){  // lots of ties
      word:=words[(0).random(nwds)];
      if(word.matches(v[0][0,word.len()])) return(word,n); // "??" !match "abc"
   }}}
   False
}
fcn pasteWord(r,c, dr,dc, word)  // jam word into grid along vector
   { foreach char in (word){ grid[r][c]=char; r+=dr; c+=dc; } }
fcn printGrid{
   println("\n   0 1 2 3 4 5 6 7 8 9");
   foreach n,line in (grid.enumerate()){ println(n,"  ",line.concat(" ")) }
}
fcn stuff(msg){ MSG:=msg.toUpper() : Utils.Helpers.cycle(_);
   foreach r,c in (10,10){ if(grid[r][c]=="?") grid[r][c]=MSG.next() }
   MSG._n==msg.len()   // use all of, not more, not less, of msg?
}


F word_wrap(text, line_width)
   V words = text.split_py()
   I words.empty
      R ‘’
   V wrapped = words[0]
   V space_left = line_width - wrapped.len
   L(word) words[1..]
      I word.len + 1 > space_left
         wrapped ‘’= "\n"word
         space_left = line_width - word.len
      E
         wrapped ‘’= ‘ ’word
         space_left -= 1 + word.len
   R wrapped

V frog = ‘
In olden times when wishing still helped one, there lived a king
whose daughters were all beautiful, but the youngest was so beautiful
that the sun itself, which has seen so much, was astonished whenever
it shone in her face.  Close by the king's castle lay a great dark
forest, and under an old lime-tree in the forest was a well, and when
the day was very warm, the king's child went out into the forest and
sat down by the side of the cool fountain, and when she was bored she
took a golden ball, and threw it up on high and caught it, and this
ball was her favorite plaything.’

L(width) (72, 80)
   print(‘Wrapped at ’width":\n"word_wrap(frog, width))
   print()


*        Word wrap                 29/01/2017
WORDWRAP CSECT
         USING  WORDWRAP,R13
         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            " addressability
         MVC    S2,=CL96' '        s2=''
         SR     R0,R0
         STH    R0,LENS2           lens2=0
         LA     R8,1               i=1
LOOPI    CH     R8,=AL2(NTS)       do i=1 to hbound(ts)
         BH     ELOOPI             --
         LH     R4,LENS2
         LTR    R4,R4              if lens2=0
         BNZ    IFLENS2            then
         LR     R1,R8                i
         MH     R1,=H'48'
         LA     R14,TS-48(R1)
         MVC    S(48),0(R14)         s=ts(i)
         MVC    S+48(48),=CL48' '
         LA     R12,L'TS             jmax=length(ts)
         B      EIFLENS2           else
IFLENS2  MVC    S,=CL96' '           s=''
         LA     R6,S                 @s
         LH     R7,LENS2
         LA     R4,S2                @s2
         LH     R5,LENS2
         MVCL   R6,R4              substr(s,1,lens2)=substr(s2,1,lens2)
         LH     R2,LENS2
         LA     R2,1(R2)             lens2+1
         LR     R1,R8                i
         MH     R1,=H'48'
         LA     R14,TS-48(R1)        @ts(i)
         LA     R15,S-1
         AR     R15,R2
         MVC    0(48,R15),0(R14)     substr(s,lens2+1,48)=ts(i)
         LA     R12,L'S              jmax=length(s)
EIFLENS2 MVI    OKS2,X'01'         oks2=true
WHILEOK  CLI    OKS2,X'01'         do while(oks2)
         BNE    EWHILEOK           --
         LR     R9,R12             j=jmax  /*loop1*/
LOOPJ1   CH     R9,=H'1'           do j=jmax to 1 by -1
         BL     ELOOPJ1            --
         LA     R14,S-1              @s-1
         AR     R14,R9               j
         MVC    CJ(1),0(R14)         cj=substr(s,j,1)
         CLI    CJ,C' '              if cj^=' '
         BNE    ELOOPJ1              then leave j
         BCTR   R9,0                 j=j-1
         B      LOOPJ1             end do j
ELOOPJ1  STH    R9,LENS            lens=j  {length of s}
         MVI    OKJ,X'00'          okj=false  /*loop2*/
         LH     R11,W              js=w
         LH     R4,W
         CH     R4,LENS            if w>lens
         BNH    IFWLENS
         LH     R11,LENS           js=lens
IFWLENS  LR     R9,R11             j=js
LOOPJ2   CH     R9,=H'1'           do j=js to 1 by -1
         BL     ELOOPJ2            --
         LA     R14,S-1              @s-1
         AR     R14,R9               +j
         MVC    CJ(1),0(R14)         cj=substr(s,j,1)
         CLI    CJ,C' '              if cj=' '
         BNE    ITERJ2               then
         MVI    OKJ,X'01'              okj=true
         B      ELOOPJ2                leave j
ITERJ2   BCTR   R9,0                 j=j-1
         B      LOOPJ2             end do j
ELOOPJ2  CLI    OKJ,X'00'          if ^okj
         BNE    ELOOPK
         MVI    OKK,X'00'          okk=false  /*loop3*/
         LH     R10,W              k=w
LOOPK    CH     R10,LENS           do k=w to lens
         BH     ELOOPK             --
         LA     R14,S-1              @s-1
         AR     R14,R10              +k
         MVC    CK(1),0(R14)         ck=substr(s,k,1)
         CLI    CK,C' '              if ck=' '
         BNE    ITERK                then
         MVI    OKK,X'01'              okk=true
         B      ELOOPK                 leave k
ITERK    LA     R10,1(R10)           k=k+1
         B      LOOPK              end do k
ELOOPK   MVC    S2,=CL96' '        s2=' '
         SR     R0,R0
         STH    R0,LENS2           lens2=0
         MVI    CAS,X'01'          cas=true
         LH     R1,LENS
         CH     R1,W               lens<w
         BL     IFLENSLW
         MVI    CAS,X'00'          cas=false
IFLENSLW CLI    CAS,X'00'          if ^cas
         BNE    IFNOTCAS           then
         CLI    OKJ,X'01'            if okj
         BNE    NOKJ                 then
         STH    R9,LENS1               lens1=j
         LH     R2,LENS
         SR     R2,R9                  -j
         LA     R2,1(R2)
         STH    R2,LENS2               lens2=lens-j+1
         LA     R6,S1
         LR     R7,R9                  j
         LA     R4,S
         LR     R5,R7
         MVCL   R6,R4                  s1=substr(s,1,j)
         LH     R4,LENS2
         LTR    R4,R4                  if lens2>0
         BNP    ELJLENS2               then
         LA     R6,S2
         LH     R7,LENS2
         LA     R4,S(R9)                 @s(j+1)
         LR     R5,R7
         MVCL   R6,R4                    s2=substr(s,j+1,lens2)
         B      EFJLENS2
ELJLENS2 SR     R0,R0                  else
         STH    R0,LENS2                 lens2=0
EFJLENS2 B      IFNOTCAS
NOKJ     CLI    OKK,X'01'            else if okk
         BNE    NOTOKK
         STH    R10,LENS1              lens1=k
         LH     R2,LENS
         SR     R2,R10                 -k
         LA     R2,1(R2)
         STH    R2,LENS2               lens2=lens-k+1
         LA     R6,S1
         LR     R7,R10                 k
         LA     R4,S
         LR     R5,R7
         MVCL   R6,R4                  s1=substr(s,1,k)
         LH     R4,LENS2
         LTR    R4,R4                  if lens2>0
         BNP    ELKLENS2               then
         LA     R6,S2
         LH     R7,LENS2
         LA     R4,S(R10)                @s(k+1)
         LR     R5,R7
         MVCL   R6,R4                    s2=substr(s,k+1,lens2)
         B      EFKLENS2               else
ELKLENS2 SR     R0,R0
         STH    R0,LENS2                 lens2=0
EFKLENS2 B      IFNOTCAS             else
NOTOKK   LH     R0,LENS
         STH    R0,LENS1               lens1=lens
         MVC    S1,S                   s1=s
IFNOTCAS CLI    CAS,X'01'          if cas
         BNE    ELCAS              then
         LH     R7,LENS
         LA     R7,1(R7)
         LA     R6,S2
         LA     R4,S
         LR     R5,R7
         MVCL   R6,R4                s2=substr(s,1,lens+1)
         LH     R2,LENS
         LA     R2,1(R2)
         STH    R2,LENS2             lens2=lens+1
         B      EFCAS              else
ELCAS    LA     R6,PG
         LA     R7,L'PG
         LA     R4,S1
         LH     R5,LENS1
         ICM    R5,B'1000',=C' '     padding
         MVCL   R6,R4                pg=substr(s1,1,lens1)
         XPRNT  PG,L'PG              put skip list(pg)
EFCAS    MVI    OKS2,X'00'         oks2=false
         LH     R4,LENS2
         CH     R4,W               if lens2>w
         BNH    EFWLENS2           then
         MVI    OKS2,X'01'           oks2=true
         LH     R0,LENS2
         STH    R0,LENS              lens=lens2
         MVC    S,S2                 s=s2
EFWLENS2 B      WHILEOK            end while
EWHILEOK LA     R8,1(R8)           i=i+1
         B      LOOPI              end do i
ELOOPI   LH     R4,LENS2
         LTR    R4,R4              if lens2^=0
         BZ     EFLENS2N           then
         LA     R6,PG
         LA     R7,L'PG
         LA     R4,S2
         LH     R5,LENS2
         ICM    R5,B'1000',=C' '     padding
         MVCL   R6,R4                pg=substr(s2,1,lens2)
         XPRNT  PG,L'PG              put skip list(pg)
EFLENS2N L      R13,4(0,R13)       epilog
         LM     R14,R12,12(R13)    " restore
         XR     R15,R15            " rc=0
         BR     R14                exit
TS       DC     CL48'In olden times when wishing still helped one,'
         DC     CL48'there lived a king whose daughters were all,'
         DC     CL48'beautiful, but the youngest was so beautiful'
         DC     CL48'that the sun itself, which has seen so much,'
         DC     CL48'was astonished whenever it shone in her face.'
         DC     CL48'Close by the king''s castle lay a great dark'
         DC     CL48'forest, and under an old lime tree in the'
         DC     CL48'forest was a well, and when the day was very'
         DC     CL48'warm, the king''s child went out into the forest'
         DC     CL48'and sat down by the side of the cool fountain,'
         DC     CL48'and when she was bored she took a golden ball,'
         DC     CL48'and threw it up on high and caught it, and this'
         DC     CL48'ball was her favorite plaything.'
TSE      DC     0C
NTS      EQU    (TSE-TS)/L'TS
W        DC     H'36'              <-- input width  12<=w<=80
LENS     DS     H
S        DS     CL96
LENS1    DS     H
S1       DS     CL96
LENS2    DS     H
S2       DS     CL96
OKJ      DS     X
OKK      DS     X
OKS2     DS     X
CAS      DS     X
CJ       DS     CL1
CK       DS     CL1
PG       DS     CL80
         YREGS
         END    WORDWRAP


CHAR ARRAY text(1000)
CARD length

PROC AppendText(CHAR ARRAY part)
  BYTE i

  FOR i=1 TO part(0)
  DO
    text(length)=part(i)
    length==+1
  OD
RETURN

INT FUNC GetPosForWrap(BYTE lineLen INT start)
  INT pos

  pos=start+lineLen
  IF pos>=length THEN
    RETURN (length-1)
  FI

  WHILE pos>start AND text(pos)#32
  DO
    pos==-1
  OD

  IF pos=start THEN
    pos=start+lineLen
  ELSE
    pos==-1
  FI
RETURN (pos)

PROC PrintTextWrapped(BYTE lineLen)
  INT i,pos
  BYTE wrap,screenWidth=[40]

  i=0
  WHILE i<length
  DO
    pos=GetPosForWrap(lineLen,i)
    IF pos-i=screenWidth-1 OR pos=length-1 THEN
      wrap=0
    ELSE
      wrap=1
    FI

    WHILE i<=pos
    DO
      Put(text(i))
      i==+1
    OD
    WHILE i<length AND text(i)=32
    DO
      i==+1
    OD

    IF wrap THEN
      PutE()
    FI
  OD
RETURN

PROC Test(BYTE lineLen)
  BYTE CH=$02FC

  Put(125) ;clear screen
  PrintF("Line length=%B%E%E",lineLen)
  PrintTextWrapped(lineLen)
  PrintF("%E%EPress any key to continue...")

  DO UNTIL CH#$FF OD
  CH=$FF
RETURN

PROC Main()
  BYTE LMARGIN=$52,old

  length=0
  AppendText("Lorem ipsum dolor sit amet, consectetur adipiscing elit. ")
  AppendText("Maecenas varius sapien vel purus hendrerit vehicula. ")
  AppendText("Integer hendrerit viverra turpis, ac sagittis arcu pharetra id. ")
  AppendText("Sed dapibus enim non dui posuere sit amet rhoncus tellus consectetur. ")
  AppendText("Proin blandit lacus vitae nibh tincidunt cursus. ")
  AppendText("Cum sociis natoque penatibus et magnis dis parturient montes, nascetur ridiculus mus. ")
  AppendText("Nam tincidunt purus at tortor tincidunt et aliquam dui gravida. ")
  AppendText("Nulla consectetur sem vel felis vulputate et imperdiet orci pharetra. ")
  AppendText("Nam vel tortor nisi. Sed eget porta tortor. ")
  AppendText("Aliquam suscipit lacus vel odio faucibus tempor. ")
  AppendText("Sed ipsum est, condimentum eget eleifend ac, ultricies non dui.")

  old=LMARGIN
  LMARGIN=0 ;remove left margin on the screen

  Test(40)
  Test(30)
  Test(20)

  LMARGIN=old ;restore left margin on the screen
RETURN


generic
   with procedure Put_Line(Line: String);
package Word_Wrap is

   type Basic(Length_Of_Output_Line: Positive) is tagged private;

   procedure Push_Word(State: in out Basic; Word: String);
   procedure New_Paragraph(State: in out Basic);
   procedure Finish(State: in out Basic);

private
   type Basic(Length_Of_Output_Line: Positive) is tagged record
      Line: String(1 .. Length_Of_Output_Line);
      Size: Natural := 0; -- Line(1 .. Size) is relevant
      Top_Of_Paragraph: Boolean := True;
   end record;

end Word_Wrap;


on wrapParagraph(para, lineWidth)
    if (para is "") then return para
    set astid to AppleScript's text item delimiters
    set AppleScript's text item delimiters to {space, tab} -- Doesn't include character id 160 (NO-BREAK SPACE).
    script o
        property wrds : para's text items -- Space- or tab-delimited chunks.
    end script

    set spaceWidth to (count space) -- ;-)
    set spaceLeft to lineWidth
    set theLines to {}
    set i to 1
    repeat with j from 1 to (count o's wrds)
        set wordWidth to (count item j of o's wrds)
        if (wordWidth + spaceWidth > spaceLeft) then
            set end of theLines to text 1 thru (-1 - wordWidth) of (text from text item i to text item j of para)
            set i to j
            set spaceLeft to lineWidth - wordWidth
        else
            set spaceLeft to spaceLeft - (wordWidth + spaceWidth)
        end if
    end repeat
    set end of theLines to text from text item i to end of para

    set AppleScript's text item delimiters to character id 8232 -- U+2028 (LINE SEPARATOR).
    set output to theLines as text
    set AppleScript's text item delimiters to astid

    return output
end wrapParagraph

local para
set para to "If there is a way to do this that is built-in, trivial, or provided in a standard library, show that. Otherwise implement the minimum length greedy algorithm from Wikipedia."
return wrapParagraph(para, 70) & (linefeed & linefeed) & wrapParagraph(para, 40)


txt: "Lorem ipsum dolor sit amet, consectetur adipiscing elit. Donec a diam lectus. Sed sit amet ipsum mauris. Maecenas congue ligula ac quam viverra nec consectetur ante hendrerit. Donec et mollis dolor. Praesent et diam eget libero egestas mattis sit amet vitae augue. Nam tincidunt congue enim, ut porta lorem lacinia consectetur."

print wordwrap txt
print ""
print wordwrap.at:45 txt


MsgBox, % "72`n" WrapText(Clipboard, 72) "`n`n80`n" WrapText(Clipboard, 80)
return

WrapText(Text, LineLength) {
    StringReplace, Text, Text, `r`n, %A_Space%, All
    while (p := RegExMatch(Text, "(.{1," LineLength "})(\s|\R+|$)", Match, p ? p + StrLen(Match) : 1))
        Result .= Match1 ((Match2 = A_Space || Match2 = A_Tab) ? "`n" : Match2)
    return, Result
}


function wordwrap_paragraph(p)
{
  if ( length(p) < 1 ) return

  split(p, words)
  spaceLeft = lineWidth
  line = words[1]
  delete words[1]

  for (i = 1; i <= length(words); i++) {
    word = words[i]
    if ( (length(word) + 1) > spaceLeft ) {
      print line
      line = word
      spaceLeft = lineWidth -  length(word)
    } else {
      spaceLeft -= length(word) + 1
      line = line " " word
    }
  }
  print line
}

BEGIN {
  lineWidth = width
  par = ""
}

/^[ \t]*$/ {
  wordwrap_paragraph(par)
  par = ""
}

!/^[ \t]*$/ {
  par = par " " $0
}

END {
  wordwrap_paragraph(par)
}


paragraph$ = "In olden times when wishing still helped one," \
" there lived a king whose daughters were all beautiful, but" \
" the youngest was so beautiful that the sun itself, which has" \
" seen so much, was astonished whenever it shone in her face." \
" Close by the king's castle lay a great dark forest, and under" \
" an old lime tree in the forest was a well, and when the day" \
" was very warm, the king's child went out into the forest and" \
" sat down by the side of the cool fountain, and when she was" \
" bored she took a golden ball, and threw it up on high and" \
" caught it, and this ball was her favorite plaything."

PRINT ALIGN$(paragraph$, 72, 0)
PRINT ALIGN$(paragraph$, 90, 0)


@echo off

set "input=Lorem ipsum dolor sit amet, consectetur adipiscing elit. Donec a diam lectus. Sed sit amet ipsum mauris. Maecenas congue ligula ac quam viverra nec consectetur ante hendrerit. Donec et mollis dolor. Praesent et diam eget libero egestas mattis sit amet vitae augue. Nam tincidunt congue enim, ut porta lorem lacinia consectetur!"
rem call the function (the second parameter is the line width)
call :wrap "%input%" 40
echo(
call :wrap "%input%" 70
pause>nul
exit /b 0

:: The procedure
:wrap
set "line="
set "tmp_str=%~1"
set /a "width=%2", "width-=1"

:proc_loop
rem check if we are done already
if "%tmp_str%"=="" (
    setlocal enabledelayedexpansion
    if defined line echo(!line!
    endlocal & goto :EOF
)

rem not yet done, so take a word and process it
for /f "tokens=1,* delims= " %%A in ("%tmp_str%") do (
    set "word=%%A"
    set "tmp_str=%%B"

    setlocal enabledelayedexpansion
    if "!line!"=="" (set "testline=!word!") else (set "testline=!line! !word!")
    if "!testline:~%width%,1!" == "" (
        set "line=!testline!"
    ) else (
        echo(!line!
        set "line=!word!"
    )
)
endlocal & set "line=%line%"
goto proc_loop


(     str
    $ ( "In olden times when wishing still helped one, there lived a king "
        "whose daughters were all beautiful, but the youngest was so beautiful "
        "that the sun itself, which has seen so much, was astonished whenever "
        "it shone in her face.  Close by the king's castle lay a great dark "
        "forest, and under an old lime tree in the forest was a well, and when "
        "the day was very warm, the king's child went out into the forest and "
        "sat down by the side of the cool fountain, and when she was bored she "
        "took a golden ball, and threw it up on high and caught it, and this "
        "ball was her favorite plaything."
      )
  : ?Text
& ( wrap
  =   txt length line output q rem
    .   !arg:(?txt.?length)
      & :?output
      &   whl
        ' ( @( str$!txt
             :   ?line
                 (" " %?lastword [?q " " ?rem&!q:~<!length)
             )
          & !lastword " " !rem:?txt
          & !output !line \n:?output
          )
      & str$(!output !txt)
  )
& out$(str$("72 columns:\n" wrap$(!Text.72)))
& out$(str$("\n80 columns:\n" wrap$(!Text.80)))
);


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

/* nonsensical hyphens to make greedy wrapping method look bad */
const char *string = "In olden times when wishing still helped one, there lived a king "
    "whose daughters were all beautiful, but the youngest was so beautiful "
    "that the sun itself, which has seen so much, was astonished whenever "
    "it shone-in-her-face.  Close-by-the-king's castle lay a great dark "
    "forest, and under an old lime-tree in the forest was a well, and when "
    "the day was very warm, the king's child went out into the forest and "
    "sat down by the side of the cool-fountain, and when she was bored she "
    "took a golden ball, and threw it up on high and caught it, and this "
    "ball was her favorite plaything.";

/*  Each but the last of wrapped lines comes with some penalty as the square
    of the diff between line length and desired line length.  If the line
    is longer than desired length, the penalty is multiplied by 100.  This
    pretty much prohibits the wrapping routine from going over right margin.
    If is ok to exceed the margin just a little, something like 20 or 40 will
    do.

    Knuth uses a per-paragraph penalty for line-breaking in TeX, which is--
    unlike what I have here--probably bug-free.
*/

#define PENALTY_LONG    100
#define PENALTY_SHORT   1

typedef struct word_t {
    const char *s;
    int len;
} *word;

word make_word_list(const char *s, int *n)
{
    int max_n = 0;
    word words = 0;

    *n = 0;
    while (1) {
        while (*s && isspace(*s)) s++;
        if (!*s) break;

        if (*n >= max_n) {
            if (!(max_n *= 2)) max_n = 2;
            words = realloc(words, max_n * sizeof(*words));
        }
        words[*n].s = s;
        while (*s && !isspace(*s)) s++;
        words[*n].len = s - words[*n].s;
        (*n) ++;
    }

    return words;
}

int greedy_wrap(word words, int count, int cols, int *breaks)
{
    int score = 0, line, i, j, d;

    i = j = line = 0;
    while (1) {
        if (i == count) {
            breaks[j++] = i;
            break;
        }

        if (!line) {
            line = words[i++].len;
            continue;
        }

        if (line + words[i].len < cols) {
            line += words[i++].len + 1;
            continue;
        }

        breaks[j++] = i;
        if (i < count) {
            d = cols - line;
            if (d > 0)  score += PENALTY_SHORT * d * d;
            else if (d < 0) score += PENALTY_LONG * d * d;
        }

        line = 0;
    }
    breaks[j++] = 0;

    return score;
}

/* tries to make right margin more even; pretty sure there's an off-by-one bug
    here somewhere */
int balanced_wrap(word words, int count, int cols, int *breaks)
{
    int *best = malloc(sizeof(int) * (count + 1));

    /* do a greedy wrap to have some baseline score to work with, else
       we'll end up with O(2^N) behavior */
    int best_score = greedy_wrap(words, count, cols, breaks);

    void test_wrap(int line_no, int start, int score) {
        int line = 0, current_score = -1, d;

        while (start <= count) {
            if (line) line ++;
            line += words[start++].len;
            d = cols - line;
            if (start < count || d < 0) {
                if (d > 0)
                    current_score = score + PENALTY_SHORT * d * d;
                else
                    current_score = score + PENALTY_LONG * d * d;
            } else {
                current_score = score;
            }

            if (current_score >= best_score) {
                if (d <= 0) return;
                continue;
            }

            best[line_no] = start;
            test_wrap(line_no + 1, start, current_score);
        }
        if (current_score >= 0 && current_score < best_score) {
            best_score = current_score;
            memcpy(breaks, best, sizeof(int) * (line_no));
        }
    }
    test_wrap(0, 0, 0);
    free(best);

    return best_score;
}

void show_wrap(word list, int count, int *breaks)
{
    int i, j;
    for (i = j = 0; i < count && breaks[i]; i++) {
        while (j < breaks[i]) {
            printf("%.*s", list[j].len, list[j].s);
            if (j < breaks[i] - 1)
                putchar(' ');
            j++;
        }
        if (breaks[i]) putchar('\n');
    }
}

int main(void)
{
    int len, score, cols;
    word list = make_word_list(string, &len);
    int *breaks = malloc(sizeof(int) * (len + 1));

    cols = 80;
    score = greedy_wrap(list, len, cols, breaks);
    printf("\n== greedy wrap at %d (score %d) ==\n\n", cols, score);
    show_wrap(list, len, breaks);

    score = balanced_wrap(list, len, cols, breaks);
    printf("\n== balanced wrap at %d (score %d) ==\n\n", cols, score);
    show_wrap(list, len, breaks);

    cols = 32;
    score = greedy_wrap(list, len, cols, breaks);
    printf("\n== greedy wrap at %d (score %d) ==\n\n", cols, score);
    show_wrap(list, len, breaks);

    score = balanced_wrap(list, len, cols, breaks);
    printf("\n== balanced wrap at %d (score %d) ==\n\n", cols, score);
    show_wrap(list, len, breaks);

    return 0;
}


namespace RosettaCode.WordWrap
{
    using System;
    using System.Collections.Generic;

    internal static class Program
    {
        private const string LoremIpsum = @"
Lorem ipsum dolor sit amet, consectetur adipiscing elit. Maecenas varius sapien
vel purus hendrerit vehicula. Integer hendrerit viverra turpis, ac sagittis arcu
pharetra id. Sed dapibus enim non dui posuere sit amet rhoncus tellus
consectetur. Proin blandit lacus vitae nibh tincidunt cursus. Cum sociis natoque
penatibus et magnis dis parturient montes, nascetur ridiculus mus. Nam tincidunt
purus at tortor tincidunt et aliquam dui gravida. Nulla consectetur sem vel
felis vulputate et imperdiet orci pharetra. Nam vel tortor nisi. Sed eget porta
tortor. Aliquam suscipit lacus vel odio faucibus tempor. Sed ipsum est,
condimentum eget eleifend ac, ultricies non dui. Integer tempus, nunc sed
venenatis feugiat, augue orci pellentesque risus, nec pretium lacus enim eu
nibh.";

        private static void Main()
        {
            foreach (var lineWidth in new[] { 72, 80 })
            {
                Console.WriteLine(new string('-', lineWidth));
                Console.WriteLine(Wrap(LoremIpsum, lineWidth));
            }
        }

        private static string Wrap(string text, int lineWidth)
        {
            return string.Join(string.Empty,
                               Wrap(
                                   text.Split(new char[0],
                                              StringSplitOptions
                                                  .RemoveEmptyEntries),
                                   lineWidth));
        }

        private static IEnumerable<string> Wrap(IEnumerable<string> words,
                                                int lineWidth)
        {
            var currentWidth = 0;
            foreach (var word in words)
            {
                if (currentWidth != 0)
                {
                    if (currentWidth + word.Length < lineWidth)
                    {
                        currentWidth++;
                        yield return " ";
                    }
                    else
                    {
                        currentWidth = 0;
                        yield return Environment.NewLine;
                    }
                }
                currentWidth += word.Length;
                yield return word;
            }
        }
    }
}


#include <iostream>
#include <sstream>
#include <string>

const char *text =
{
    "In olden times when wishing still helped one, there lived a king "
    "whose daughters were all beautiful, but the youngest was so beautiful "
    "that the sun itself, which has seen so much, was astonished whenever "
    "it shone in her face.  Close by the king's castle lay a great dark "
    "forest, and under an old lime tree in the forest was a well, and when "
    "the day was very warm, the king's child went out into the forest and "
    "sat down by the side of the cool fountain, and when she was bored she "
    "took a golden ball, and threw it up on high and caught it, and this "
    "ball was her favorite plaything."
};

std::string wrap(const char *text, size_t line_length = 72)
{
    std::istringstream words(text);
    std::ostringstream wrapped;
    std::string word;

    if (words >> word) {
        wrapped << word;
        size_t space_left = line_length - word.length();
        while (words >> word) {
            if (space_left < word.length() + 1) {
                wrapped << '\n' << word;
                space_left = line_length - word.length();
            } else {
                wrapped << ' ' << word;
                space_left -= word.length() + 1;
            }
        }
    }
    return wrapped.str();
}

int main()
{
    std::cout << "Wrapped at 72:\n" << wrap(text) << "\n\n";
    std::cout << "Wrapped at 80:\n" << wrap(text, 80) << "\n";
}


;; Wrap line naive version
(defn wrap-line [size text]
  (loop [left size line [] lines []
         words (clojure.string/split text #"\s+")]
    (if-let [word (first words)]
      (let [wlen (count word)
            spacing (if (== left size) "" " ")
            alen (+ (count spacing) wlen)]
        (if (<= alen left)
          (recur (- left alen) (conj line spacing word) lines (next words))
          (recur (- size wlen) [word] (conj lines (apply str line)) (next words))))
      (when (seq line)
        (conj lines (apply str line))))))


10 rem word wrap - commodore basic
20 rem rosetta code
30 s$="":co=40:gosub 200
35 print chr$(147);chr$(14)
40 print "The current string is:"
41 print chr$(18);s$;chr$(146)
42 print:print "Enter a string, blank to keep previous,"
43 print "or type 'sample' to use a preset"len(z$)"   character string."
44 print:input s$:if s$="sample" then s$=z$
45 print:print "enter column limit, 10-80 [";co;"{left}]";:input co
46 if co<12 or co>80 then goto 45
50 print chr$(147);"Wrapping on column";co;"results as:"
55 gosub 400
60 print
65 print r$
70 print
80 input "Again (y/n)";yn$
90 if yn$="y" then goto 35
100 end
200 rem set up sample string
205 data "Lorem Ipsum is typically a corrupted version of 'De finibus "
210 data "bonorum et malorum', a first-century BC text by the Roman statesman "
215 data "and philosopher Cicero, with words altered, added, and removed to "
220 data "make it nonsensical, improper Latin."
225 data "zzz"
230 z$=""
235 read tp$:if tp$<>"zzz" then z$=z$+tp$:goto 235
240 return
400 rem word-wrap string
401 tp$=s$:as$=""
405 if len(tp$)<=co then goto 440
410 for i=0 to co-1:c$=mid$(tp$,co-i,1)
420 if c$<>" " and c$<>"-" then next i
425 ad$=chr$(13):if c$="-" then ad$="-"+chr$(13)
430 as$=as$+left$(tp$,co-1-i)+ad$:tp$=mid$(tp$,co-i+1,len(tp$)):i=0
435 goto 405
440 as$=as$+tp$
450 r$=as$
460 return


;; Greedy wrap line

(defun greedy-wrap (str width)
  (setq str (concatenate 'string str " ")) ; add sentinel
  (do* ((len (length str))
        (lines nil)
        (begin-curr-line 0)
        (prev-space 0 pos-space)
        (pos-space (position #\Space str) (when (< (1+ prev-space) len) (position #\Space str :start (1+ prev-space)))) )
       ((null pos-space) (progn (push (subseq str begin-curr-line (1- len)) lines) (nreverse lines)) )
    (when (> (- pos-space begin-curr-line) width)
      (push (subseq str begin-curr-line prev-space) lines)
      (setq begin-curr-line (1+ prev-space)) )))


void main() {
    immutable frog =
"In olden times when wishing still helped one, there lived a king
whose daughters were all beautiful, but the youngest was so beautiful
that the sun itself, which has seen so much, was astonished whenever
it shone in her face.  Close by the king's castle lay a great dark
forest, and under an old lime-tree in the forest was a well, and when
the day was very warm, the king's child went out into the forest and
sat down by the side of the cool fountain, and when she was bored she
took a golden ball, and threw it up on high and caught it, and this
ball was her favorite plaything.";

    import std.stdio, std.string;
    foreach (width; [72, 80])
        writefln("Wrapped at %d:\n%s\n", width, frog.wrap(width));
}


let loremIpsum = <[Lorem ipsum dolor sit amet, consectetur adipiscing elit. Maecenas varius sapien
vel purus hendrerit vehicula. Integer hendrerit viverra turpis, ac sagittis arcu
pharetra id. Sed dapibus enim non dui posuere sit amet rhoncus tellus
consectetur. Proin blandit lacus vitae nibh tincidunt cursus. Cum sociis natoque
penatibus et magnis dis parturient montes, nascetur ridiculus mus. Nam tincidunt
purus at tortor tincidunt et aliquam dui gravida. Nulla consectetur sem vel
felis vulputate et imperdiet orci pharetra. Nam vel tortor nisi. Sed eget porta
tortor. Aliquam suscipit lacus vel odio faucibus tempor. Sed ipsum est,
condimentum eget eleifend ac, ultricies non dui. Integer tempus, nunc sed
venenatis feugiat, augue orci pellentesque risus, nec pretium lacus enim eu
nibh.]>

func wrap(text, lineWidth) {
    String.Concat(values: wrapWords(text.Split('\s', '\r', '\n'), lineWidth))
}
and wrapWords(words, lineWidth) {
    var currentWidth = 0

    for word in words {
        if currentWidth != 0 {
            if currentWidth + word.Length() < lineWidth {
                currentWidth += 1
                yield " "
            } else {
                currentWidth = 0
                yield "\n"
            }
        }
        currentWidth += word.Length()
        yield word
    }
}
and printWrap(at) {
    print("Wrap at \(at):")
    print(wrap(loremIpsum, at))
    print()
}

printWrap(at: 72)
printWrap(at: 80)


import extensions;
import system'routines;
import extensions'text;

string text =
    "In olden times when wishing still helped one, there lived a king
whose daughters were all beautiful, but the youngest was so beautiful
that the sun itself, which has seen so much, was astonished whenever
it shone in her face.  Close by the king's castle lay a great dark
forest, and under an old lime tree in the forest was a well, and when
the day was very warm, the king's child went out into the forest and
sat down by the side of the cool fountain, and when she was bored she
took a golden ball, and threw it up on high and caught it, and this
ball was her favorite plaything.";

extension wrapOp
{
    wrap(int lineWidth)
    {
        int currentWidth := 0;

        ^ TokenEnumerator
            .new(self)
            .selectBy:(word)
            {
                currentWidth += word.Length;
                if (currentWidth > lineWidth)
                {
                    currentWidth := word.Length + 1;

                    ^ newLine + word + " "
                }
                else
                {
                    currentWidth += 1;

                    ^  word + " "
                }
            }
            .summarize(new StringWriter())
    }
}

public program()
{
    console.printLine(new StringWriter("-", 72));
    console.printLine(text.wrap(72));
    console.printLine(new StringWriter("-", 80));
    console.printLine(text.wrap(80));
}


defmodule Word_wrap do
  def paragraph( string, max_line_length ) do
    [word | rest] = String.split( string, ~r/\s+/, trim: true )
    lines_assemble( rest, max_line_length, String.length(word), word, [] )
      |> Enum.join( "\n" )
  end

  defp lines_assemble( [], _, _, line, acc ), do: [line | acc] |> Enum.reverse
  defp lines_assemble( [word | rest], max, line_length, line, acc ) do
    if line_length + 1 + String.length(word) > max do
      lines_assemble( rest, max, String.length(word), word, [line | acc] )
    else
      lines_assemble( rest, max, line_length + 1 + String.length(word), line <> " " <> word, acc )
    end
  end
end

text = """
Even today, with proportional fonts and complex layouts, there are still cases where you need to
wrap text at a specified column. The basic task is to wrap a paragraph of text in a simple way in
your language. If there is a way to do this that is built-in, trivial, or provided in a standard
library, show that. Otherwise implement the minimum length greedy algorithm from Wikipedia.
"""
Enum.each([72, 80], fn len ->
  IO.puts String.duplicate("-", len)
  IO.puts Word_wrap.paragraph(text, len)
end)


-module( word_wrap ).

-export( [paragraph/2, task/0] ).

paragraph( String, Max_line_length ) ->
    Lines = lines( string:tokens(String, " "), Max_line_length ),
    string:join( Lines, "\n" ).

task() ->
    Paragraph = "Even today, with proportional fonts and complex layouts, there are still cases where you need to wrap text at a specified column. The basic task is to wrap a paragraph of text in a simple way in your language. If there is a way to do this that is built-in, trivial, or provided in a standard library, show that. Otherwise implement the minimum length greedy algorithm from Wikipedia.",
    io:fwrite( "~s~n~n", [paragraph(Paragraph, 72)] ),
    io:fwrite( "~s~n~n", [paragraph(Paragraph, 80)] ).

lines( [Word | T], Max_line_length ) ->
    {Max_line_length, _Length, Last_line, Lines} = lists:foldl( fun lines_assemble/2, {Max_line_length, erlang:length(Word), Word, []}, T ),
    lists:reverse( [Last_line | Lines] ).

lines_assemble( Word, {Max, Line_length, Line, Acc} ) when erlang:length(Word) + Line_length > Max -> {Max, erlang:length(Word), Word, [Line | Acc]};
lines_assemble( Word, {Max, Line_length, Line, Acc} ) -> {Max, Line_length + 1 + erlang:length(Word), Line ++ " " ++ Word, Acc}.


open System

let LoremIpsum = "
Lorem ipsum dolor sit amet, consectetur adipiscing elit. Maecenas varius sapien
vel purus hendrerit vehicula. Integer hendrerit viverra turpis, ac sagittis arcu
pharetra id. Sed dapibus enim non dui posuere sit amet rhoncus tellus
consectetur. Proin blandit lacus vitae nibh tincidunt cursus. Cum sociis natoque
penatibus et magnis dis parturient montes, nascetur ridiculus mus. Nam tincidunt
purus at tortor tincidunt et aliquam dui gravida. Nulla consectetur sem vel
felis vulputate et imperdiet orci pharetra. Nam vel tortor nisi. Sed eget porta
tortor. Aliquam suscipit lacus vel odio faucibus tempor. Sed ipsum est,
condimentum eget eleifend ac, ultricies non dui. Integer tempus, nunc sed
venenatis feugiat, augue orci pellentesque risus, nec pretium lacus enim eu
nibh."

let Wrap words lineWidth =
    let rec loop words currentWidth = seq {
        match (words : string list) with
        | word :: rest ->
            let (stuff, pos) =
                if currentWidth > 0 then
                    if currentWidth + word.Length < lineWidth then
                        (" ", (currentWidth + 1))
                    else
                        ("\n", 0)
                else ("", 0)
            yield stuff + word
            yield! loop rest (pos + word.Length)
        | _ -> ()
    }
    loop words 0

[<EntryPoint>]
let main argv =
    for n in [72; 80] do
        printfn "%s" (String('-', n))
        let l = Seq.toList (LoremIpsum.Split((null:char[]), StringSplitOptions.RemoveEmptyEntries))
        Wrap l n |> Seq.iter (printf "%s")
        printfn ""
    0


USE: wrap.strings
IN: scratchpad "Most languages in widespread use today are applicative languages
: the central construct in the language is some form of function call, where a f
unction is applied to a set of parameters, where each parameter is itself the re
sult of a function call, the name of a variable, or a constant. In stack languag
es, a function call is made by simply writing the name of the function; the para
meters are implicit, and they have to already be on the stack when the call is m
ade. The result of the function call (if any) is then left on the stack after th
e function returns, for the next function to consume, and so on. Because functio
ns are invoked simply by mentioning their name without any additional syntax, Fo
rth and Factor refer to functions as words, because in the syntax they really ar
e just words." [ 60 wrap-string print nl ] [ 45 wrap-string print ] bi


\ wrap text
\ usage: gforth wrap.f in.txt 72

0. argc @ 1- arg >number 2drop drop constant maxLine

: .wrapped ( buf len -- )
  begin
    dup maxLine >
  while
    over maxLine
    begin 1- 2dup + [email protected] bl = until
    dup 1+ >r
    begin 1- 2dup + [email protected] bl <> until
    1+ type cr
    r> /string
  repeat type cr ;

: strip-nl ( buf len -- )
  bounds do
    i [email protected] 10 = if bl i c! then
  loop ;

argc @ 2 - arg slurp-file
2dup strip-nl
.wrapped
bye


Dim Shared As String texto, dividido()

texto = "In olden times when wishing still helped one, there lived a king " &_
"whose daughters were all beautiful, but the youngest was so beautiful "&_
"that the sun itself, which has seen so much, was astonished whenever "&_
"it shone-in-her-face.  Close-by-the-king's castle lay a great dark "&_
"forest, and under an old lime-tree in the forest was a well, and when "&_
"the day was very warm, the king's child went out into the forest and "&_
"sat down by the side of the cool-fountain, and when she was bored she "&_
"took a golden ball, and threw it up on high and caught it, and this "&_
"ball was her favorite plaything."

Sub Split(splitArray() As String, subject As String, delimitador As String = " ")
    Dim As Integer esteDelim, sgteDelim, toks
    Dim As String tok

    Redim splitArray(toks)

    Do While Strptr(subject)
        sgteDelim = Instr(esteDelim + 1, subject, delimitador)
        splitArray(toks) = Mid(subject, esteDelim + 1, sgteDelim - esteDelim - 1)
        If sgteDelim = FALSE Then Exit Do
        toks += 1
        Redim Preserve splitArray(toks)
        esteDelim = sgteDelim
    Loop
End Sub

Sub WordWrap(s As String, n As Integer)
    Split(dividido(),s," ")
    Dim As String fila = ""
    For i As Integer = 0 To Ubound(dividido)
        If Len(fila) = 0 Then
            fila = fila & dividido(i)
        Elseif Len(fila & " " & dividido(i)) <= n Then
            fila = fila & " " & dividido(i)
        Else
            Print fila
            fila = dividido(i)
        End If
    Next i
    If Len(fila) > 0 Then Print dividido(Ubound(dividido))
End Sub

Print "Ajustado a 72:"
WordWrap(texto,72)
Print !"\nAjustado a 80:"
WordWrap(texto,80)
Sleep


package main

import (
    "fmt"
    "strings"
)

func wrap(text string, lineWidth int) (wrapped string) {
    words := strings.Fields(text)
    if len(words) == 0 {
        return
    }
    wrapped = words[0]
    spaceLeft := lineWidth - len(wrapped)
    for _, word := range words[1:] {
        if len(word)+1 > spaceLeft {
            wrapped += "\n" + word
            spaceLeft = lineWidth - len(word)
        } else {
            wrapped += " " + word
            spaceLeft -= 1 + len(word)
        }
    }
    return
}

var frog = `
In olden times when wishing still helped one, there lived a king
whose daughters were all beautiful, but the youngest was so beautiful
that the sun itself, which has seen so much, was astonished whenever
it shone in her face.  Close by the king's castle lay a great dark
forest, and under an old lime-tree in the forest was a well, and when
the day was very warm, the king's child went out into the forest and
sat down by the side of the cool fountain, and when she was bored she
took a golden ball, and threw it up on high and caught it, and this
ball was her favorite plaything.`

func main() {
    fmt.Println("wrapped at 80:")
    fmt.Println(wrap(frog, 80))
    fmt.Println("wrapped at 72:")
    fmt.Println(wrap(frog, 72))
}


def wordWrap(text, length = 80) {
    def sb = new StringBuilder()
    def line = ''

    text.split(/\s/).each { word ->
        if (line.size() + word.size() > length) {
            sb.append(line.trim()).append('\n')
            line = ''
        }
        line += " $word"
    }
    sb.append(line.trim()).toString()
}


BEGIN # find Wilson primes of order n, primes such that:                    #
      #                    ( ( n - 1 )! x ( p - n )! - (-1)^n ) mod p^2 = 0 #
    INT limit = 5 508; # max prime to consider #

    # Build list of primes. #
    []INT primes =
        BEGIN
            # sieve the primes to limit^2 which will hopefully be enough for primes #
            [ 1 : limit * limit ]BOOL prime;
            prime[ 1 ] := FALSE; prime[ 2 ] := TRUE;
            FOR i FROM 3 BY 2 TO UPB prime DO prime[ i ] := TRUE  OD;
            FOR i FROM 4 BY 2 TO UPB prime DO prime[ i ] := FALSE OD;
            FOR i FROM 3 BY 2 TO ENTIER sqrt( UPB prime ) DO
                IF prime[ i ] THEN FOR s FROM i * i BY i + i TO UPB prime DO prime[ s ] := FALSE OD FI
            OD;
            # count the primes up to the limit #
            INT p count := 0; FOR i TO limit DO IF prime[ i ] THEN p count +:= 1 FI OD;
            # construct a list of the primes #
            [ 1 : p count ]INT primes;
            INT p pos := 0;
            FOR i WHILE p pos < UPB primes DO IF prime[ i ] THEN primes[ p pos +:= 1 ] := i FI OD;
            primes
        END;

    # Build list of factorials. #
    PR precision 20000 PR # set the number of digits for a LONG LONG INT #
    [ 0 : primes[ UPB primes ] ]LONG LONG INT facts;
    facts[ 0 ] := 1; FOR i TO UPB facts DO facts[ i ] := facts[ i - 1 ] * i OD;

    # find the Wilson primes #
    INT sign := 1;
    print( ( " n: Wilson primes", newline ) );
    print( ( "-----------------", newline ) );
    FOR n TO 11 DO
        print( ( whole( n, -2 ), ":" ) );
        sign := - sign;
        LONG LONG INT f n minus 1 = facts[ n - 1 ];
        FOR p pos FROM LWB primes TO UPB primes DO
            INT p = primes[ p pos ];
            IF p >= n THEN
                LONG LONG INT f = f n minus 1 * facts[ p - n ] - sign;
                IF f MOD ( p * p ) = 0 THEN print( ( " ", whole( p, 0 ) ) ) FI
            FI
        OD;
        print( ( newline ) )
    OD
END


ss =
  concat
    [ "In olden times when wishing still helped one, there lived a king"
    , "whose daughters were all beautiful, but the youngest was so beautiful"
    , "that the sun itself, which has seen so much, was astonished whenever"
    , "it shone in her face.  Close by the king's castle lay a great dark"
    , "forest, and under an old lime-tree in the forest was a well, and when"
    , "the day was very warm, the king's child went out into the forest and"
    , "sat down by the side of the cool fountain, and when she was bored she"
    , "took a golden ball, and threw it up on high and caught it, and this"
    , "ball was her favorite plaything."
    ]

wordwrap maxlen = wrap_ 0 . words
  where
    wrap_ _ [] = "\n"
    wrap_ pos (w:ws)
              -- at line start: put down the word no matter what
      | pos == 0 = w ++ wrap_ (pos + lw) ws
      | pos + lw + 1 > maxlen = '\n' : wrap_ 0 (w : ws)
      | otherwise = ' ' : w ++ wrap_ (pos + lw + 1) ws
      where
        lw = length w

main = mapM_ putStr [wordwrap 72 ss, "\n", wordwrap 32 ss]


procedure main(A)
    ll := integer(A[1]) | 72
    wordWrap(&input, ll)
end

procedure wordWrap(f, ll)
    every (sep := "", s := "", w := words(f)) do
       if w == "\n" then write(1(.s, s := sep := ""),"\n")
       else if (*s + *w) >= ll then write(1(.s, s := w, sep := " "))
                               else (s ||:= .sep||("\n" ~== w), sep := " ")
    if *s > 0 then write(s)
end

procedure words(f)
    static wc
    initial wc := &cset -- ' \t'   # Loose definition of a 'word'...
    while l := !f do {
        l ? while tab(upto(wc)) do suspend tab(many(wc))\1
        if *trim(l) = 0 then suspend "\n"   # Paragraph boundary
        }
end


function isPrime(v)
	if v <= 1 then return False
	for i = 2 To int(sqr(v))
		if v % i = 0 then return False
	next i
	return True
end function

function isWilson(n, p)
	if p < n then return false
	prod = 1
	p2 = p*p #p^2
	for i = 1 to n-1
		prod = (prod*i) mod p2
	next i
	for i = 1 to p-n
		prod = (prod*i) mod p2
	next i
	prod = (p2 + prod - (-1)**n) mod p2
	if prod = 0 then return true else return false
end function

print " n:      Wilson primes"
print "----------------------"
for n = 1 to 11
	print n;" :  ";
	for p = 3 to 10499 step 2
		if isPrime(p) and isWilson(n, p) then print p; " ";
	next p
	print
next n
end


#include <iomanip>
#include <iostream>
#include <vector>
#include <gmpxx.h>

std::vector<int> generate_primes(int limit) {
    std::vector<bool> sieve(limit >> 1, true);
    for (int p = 3, s = 9; s < limit; p += 2) {
        if (sieve[p >> 1]) {
            for (int q = s; q < limit; q += p << 1)
                sieve[q >> 1] = false;
        }
        s += (p + 1) << 2;
    }
    std::vector<int> primes;
    if (limit > 2)
        primes.push_back(2);
    for (int i = 1; i < sieve.size(); ++i) {
        if (sieve[i])
            primes.push_back((i << 1) + 1);
    }
    return primes;
}

int main() {
    using big_int = mpz_class;
    const int limit = 11000;
    std::vector<big_int> f{1};
    f.reserve(limit);
    big_int factorial = 1;
    for (int i = 1; i < limit; ++i) {
        factorial *= i;
        f.push_back(factorial);
    }
    std::vector<int> primes = generate_primes(limit);
    std::cout << " n | Wilson primes\n--------------------\n";
    for (int n = 1, s = -1; n <= 11; ++n, s = -s) {
        std::cout << std::setw(2) << n << " |";
        for (int p : primes) {
            if (p >= n && (f[n - 1] * f[p - n] - s) % (p * p) == 0)
                std::cout << ' ' << p;
        }
        std::cout << '\n';
    }
}


100 TEXT 80
110 CALL WRITE(12,68,0)
120 PRINT :CALL WRITE(10,70,1)
130 DEF WRITE(LEFTMARGIN,RIGHTMARGIN,JUSTIFIED)
140   STRING S$*254
150   RESTORE
160   PRINT TAB(LEFTMARGIN);CHR$(243);
170   PRINT TAB(RIGHTMARGIN-1);CHR$(251)
180   DO
190     READ IF MISSING EXIT DO:S$
200     PRINT S$;
210   LOOP
220   IF JUSTIFIED THEN PRINT CHR$(248) ! <- Extra credit :-)
230   PRINT
240 END DEF
250 DATA "In olden times when wishing still helped one, there lived a king whose daughters were all beautiful, but the youngest was so beautiful that the sun itself, which has seen so much, was astonished whenever it shone in her face. "
260 DATA "Close by the king's castle lay a great dark forest, and under an old lime-tree in the forest was a well, and when the day was very warm, the king's child went out into the forest and sat down by the side of the cool fountain, "
270 DATA "and when she was bored she took a golden ball, and threw it up on high and caught it, and this ball was her favorite plaything."


package rosettacode;

import java.util.StringTokenizer;

public class WordWrap
{
    int defaultLineWidth=80;
    int defaultSpaceWidth=1;
    void minNumLinesWrap(String text)
    {
        minNumLinesWrap(text,defaultLineWidth);
    }
    void minNumLinesWrap(String text,int LineWidth)
    {
        StringTokenizer st=new StringTokenizer(text);
        int SpaceLeft=LineWidth;
        int SpaceWidth=defaultSpaceWidth;
        while(st.hasMoreTokens())
        {
            String word=st.nextToken();
            if((word.length()+SpaceWidth)>SpaceLeft)
            {
                System.out.print("\n"+word+" ");
                SpaceLeft=LineWidth-word.length();
            }
            else
            {
                System.out.print(word+" ");
                SpaceLeft-=(word.length()+SpaceWidth);
            }
        }
    }
    public static void main(String[] args)
    {
        WordWrap now=new WordWrap();
        String wodehouse="Old Mr MacFarland (_said Henry_) started the place fifteen years ago. He was a widower with one son and what you might call half a daughter. That's to say, he had adopted her. Katie was her name, and she was the child of a dead friend of his. The son's name was Andy. A little freckled nipper he was when I first knew him--one of those silent kids that don't say much and have as much obstinacy in them as if they were mules. Many's the time, in them days, I've clumped him on the head and told him to do something; and he didn't run yelling to his pa, same as most kids would have done, but just said nothing and went on not doing whatever it was I had told him to do. That was the sort of disposition Andy had, and it grew on him. Why, when he came back from Oxford College the time the old man sent for him--what I'm going to tell you about soon--he had a jaw on him like the ram of a battleship. Katie was the kid for my money. I liked Katie. We all liked Katie.";
        System.out.println("DEFAULT:");
        now.minNumLinesWrap(wodehouse);
        System.out.println("\n\nLINEWIDTH=120");
        now.minNumLinesWrap(wodehouse,120);
    }

}


// Wilson primes. Nigel Galloway: July 31st., 2021
let rec fN g=function n when n<2I->g |n->fN(n*g)(n-1I)
let fG (n:int)(p:int)=let g,p=bigint n,bigint p in (((fN 1I (g-1I))*(fN 1I (p-g))-(-1I)**n)%(p*p))=0I
[1..11]|>List.iter(fun n->printf "%2d -> " n; let fG=fG n in pCache|>Seq.skipWhile((>)n)|>Seq.takeWhile((>)11000)|>Seq.filter fG|>Seq.iter(printf "%d "); printfn "")


USING: formatting infix io kernel literals math math.functions
math.primes math.ranges prettyprint sequences sequences.extras ;

<< CONSTANT: limit 11,000 >>

CONSTANT: primes $[ limit primes-upto ]

CONSTANT: factorials
    $[ limit [1,b] 1 [ * ] accumulate* 1 prefix ]

: factorial ( n -- n! ) factorials nth ; inline

INFIX:: fn ( p n -- m )
    factorial(n-1) * factorial(p-n) - -1**n ;

: wilson? ( p n -- ? ) [ fn ] keepd sq divisor? ; inline

: order ( n -- seq )
    primes swap [ [ < ] curry drop-while ] keep
    [ wilson? ] curry filter ;

: order. ( n -- )
    dup "%2d:  " printf order [ pprint bl ] each nl ;

" n:  Wilson primes\n--------------------" print
11 [1,b] [ order. ] each


#include "isprime.bas"

function is_wilson( n as uinteger, p as uinteger ) as boolean
    'tests if p^2 divides (n-1)!(p-n)! - (-1)^n
    'does NOT test the primality of p; do that first before you call this!
    'using mods no big nums are required
    if p<n then return false
    dim as uinteger prod = 1, i, p2 = p^2
    for i = 1 to n-1
        prod = (prod*i) mod p2
    next i
    for i = 1 to p-n
        prod = (prod*i) mod p2
    next i
    prod = (p2 + prod - (-1)^n) mod p2
    if prod = 0 then return true else return false
end function

print "n:      Wilson primes"
print "--------------------"
for n as uinteger = 1 to 11
    print using "##      ";n;
        for p as uinteger = 3 to 10099 step 2
        if isprime(p) andalso is_wilson(n, p) then print p;" ";
    next p
    print
next n


package main

import (
    "fmt"
    "math/big"
    "rcu"
)

func main() {
    const LIMIT = 11000
    primes := rcu.Primes(LIMIT)
    facts := make([]*big.Int, LIMIT)
    facts[0] = big.NewInt(1)
    for i := int64(1); i < LIMIT; i++ {
        facts[i] = new(big.Int)
        facts[i].Mul(facts[i-1], big.NewInt(i))
    }
    sign := int64(1)
    f := new(big.Int)
    zero := new(big.Int)
    fmt.Println(" n:  Wilson primes")
    fmt.Println("--------------------")
    for n := 1; n < 12; n++ {
        fmt.Printf("%2d:  ", n)
        sign = -sign
        for _, p := range primes {
            if p < n {
                continue
            }
            f.Mul(facts[n-1], facts[p-n])
            f.Sub(f, big.NewInt(sign))
            p2 := int64(p * p)
            bp2 := big.NewInt(p2)
            if f.Rem(f, bp2).Cmp(zero) == 0 {
                fmt.Printf("%d ", p)
            }
        }
        fmt.Println()
    }
}


function wrap (text, limit) {
  if (text.length > limit) {
    // find the last space within limit
    var edge = text.slice(0, limit).lastIndexOf(' ');
    if (edge > 0) {
      var line = text.slice(0, edge);
      var remainder = text.slice(edge + 1);
      return line + '\n' + wrap(remainder, limit);
    }
  }
  return text;
}


# Simple greedy algorithm.
# Note: very long words are not truncated.
# input: a string
# output: an array of strings
def wrap_text(width):
  reduce splits("\\s+") as $word
    ([""];
     .[length-1] as $current
     | ($word|length) as $wl
     | (if $current == "" then 0 else 1 end) as $pad
     | if $wl + $pad + ($current|length) <= width
       then .[-1] += ($pad * " ") + $word
       else . + [ $word]
       end );


using TextWrap

text = """Reformat the single paragraph in 'text' to fit in lines of no more
    than 'width' columns, and return a new string containing the entire
    wrapped paragraph.  As with wrap(), tabs are expanded and other
    whitespace characters converted to space.  See TextWrapper class for
    available keyword args to customize wrapping behaviour."""

println("# Wrapped at 80 chars")
print_wrapped(text, width=80)
println("\n\n# Wrapped at 70 chars")
print_wrapped(text, width=70)


10 PRINT "n:     Wilson primes"
20 PRINT "--------------------"
30 FOR N = 1 TO 11
40 PRINT USING "##";N;
50 FOR P=2 TO 18
60 GOSUB 140
70 IF PT=0 THEN GOTO 100
80 GOSUB 230
90 IF WNPT=1 THEN PRINT P;
100 NEXT P
110 PRINT
120 NEXT N
130 END
140 REM tests if the number P is prime
150 REM result is stored in PT
160 PT = 1
170 IF P=2 THEN RETURN
175 IF P MOD 2 = 0 THEN PT=0:RETURN
180 J=3
190 IF J*J>P THEN RETURN
200 IF P MOD J = 0 THEN PT = 0: RETURN
210 J = J + 2
220 GOTO 190
230 REM tests if the prime P is a Wilson prime of order N
240 REM make sure it actually is prime first
250 REM RESULT is stored in WNPT
260 WNPT=0
270 IF P=2 AND N=2 THEN WNPT = 1: RETURN
280 IF N>P THEN WNPT=0: RETURN
290 PROD# = 1 : P2 = P*P
300 FOR I = 1 TO N-1
310 PROD# = (PROD#*I) : GOSUB 3000
320 NEXT I
330 FOR I = 1 TO P-N
340 PROD# = (PROD#*I) : GOSUB 3000
350 NEXT I
360 PROD# = (P2+PROD#-(-1)^N) : GOSUB 3000
370 IF PROD# = 0 THEN WNPT = 1: RETURN
380 WNPT = 0: RETURN
3000 REM    PROD# MOD P2 fails if PROD#>32767 so brew our own modulus function
3010 PROD# = PROD# - INT(PROD#/P2)*P2
3020 RETURN


import java.math.BigInteger;
import java.util.*;

public class WilsonPrimes {
    public static void main(String[] args) {
        final int limit = 11000;
        BigInteger[] f = new BigInteger[limit];
        f[0] = BigInteger.ONE;
        BigInteger factorial = BigInteger.ONE;
        for (int i = 1; i < limit; ++i) {
            factorial = factorial.multiply(BigInteger.valueOf(i));
            f[i] = factorial;
        }
        List<Integer> primes = generatePrimes(limit);
        System.out.printf(" n | Wilson primes\n--------------------\n");
        BigInteger s = BigInteger.valueOf(-1);
        for (int n = 1; n <= 11; ++n) {
            System.out.printf("%2d |", n);
            for (int p : primes) {
                if (p >= n && f[n - 1].multiply(f[p - n]).subtract(s)
                        .mod(BigInteger.valueOf(p * p))
                        .equals(BigInteger.ZERO))
                    System.out.printf(" %d", p);
            }
            s = s.negate();
            System.out.println();
        }
    }

    private static List<Integer> generatePrimes(int limit) {
        boolean[] sieve = new boolean[limit >> 1];
        Arrays.fill(sieve, true);
        for (int p = 3, s = 9; s < limit; p += 2) {
            if (sieve[p >> 1]) {
                for (int q = s; q < limit; q += p << 1)
                    sieve[q >> 1] = false;
            }
            s += (p + 1) << 2;
        }
        List<Integer> primes = new ArrayList<>();
        if (limit > 2)
            primes.add(2);
        for (int i = 1; i < sieve.length; ++i) {
            if (sieve[i])
                primes.add((i << 1) + 1);
        }
        return primes;
    }
}


:wordwrap %long !long
    %ps 0 !ps

    split
    len [ drop
        pop swap len $ps + !ps
        $ps $long > [ len !ps nl ] if
        print " " print
        $ps 1 + !ps
    ] for
    drop
;

"tlhIngan Hol jatlhwI', pIvan. ghomuv! nItebHa' mu'ghomvam wIchenmoHlaH. boQchugh Hoch, mu'ghom Dun mojlaH.
tlhIngan maH! Qapla'! DaH tlhIngan Hol mu'ghom'a' Dalegh. qawHaqvam chenmoHlu'DI' 'oHvaD wIqIpe'DIya ponglu'.
'ach jInmolvamvaD Saghbe'law' tlhIngan Hol, DIS 2005 'oH mevmoHlu'. 'ach DIS 2006 jar wa'maHcha'DIch Wikia jInmolDaq vIHta'.
Hov lengvaD chenmoHlu' tlhIngan Hol'e' 'ej DaH 'oH ghojtaH ghot law'. Qapbej Holvam wIcha'meH, qawHaqvam chenmoHlu'.
taHjaj wo', taHjaj Hol! Sov qawHaq tlhab 'oH 'ej ghItlhmey DIqonmeH tlhIngan Hol wIlo'. ghItlhmey chenmoHlaH 'ej choHlaH tlhIngan Hol
jatlhlaHbogh Hoch ghotpu''e'. wej tIn Sov qawHaqvam, 'ach ghurlI' 'e' wItul. DaH 229 ghItlhmey ngaS.
vay' Daghel DaneHchugh qoj vay' Dachup DaneHchugh, vaj tachDaq maghom."

dup

72 wordwrap nl nl
100 wordwrap nl nl

"End " input


// version 1.1.3

val text =
    "In olden times when wishing still helped one, there lived a king " +
    "whose daughters were all beautiful, but the youngest was so beautiful " +
    "that the sun itself, which has seen so much, was astonished whenever " +
    "it shone in her face.  Close by the king's castle lay a great dark " +
    "forest, and under an old lime tree in the forest was a well, and when " +
    "the day was very warm, the king's child went out into the forest and " +
    "sat down by the side of the cool fountain, and when she was bored she " +
    "took a golden ball, and threw it up on high and caught it, and this " +
    "ball was her favorite plaything."

fun greedyWordwrap(text: String, lineWidth: Int): String {
    val words = text.split(' ')
    val sb = StringBuilder(words[0])
    var spaceLeft = lineWidth - words[0].length
    for (word in words.drop(1)) {
        val len = word.length
        if (len + 1 > spaceLeft) {
            sb.append("\n").append(word)
            spaceLeft = lineWidth - len
        }
        else {
            sb.append(" ").append(word)
            spaceLeft -= (len + 1)
        }
    }
    return sb.toString()
}

fun main(args: Array<String>) {
    println("Greedy algorithm - wrapped at 72:")
    println(greedyWordwrap(text, 72))
    println("\nGreedy algorithm - wrapped at 80:")
    println(greedyWordwrap(text, 80))
}


def emit_until(cond; stream): label $out | stream | if cond then break $out else . end;

# For 0 <= $n <= ., factorials[$n] is $n !
def factorials:
   reduce range(1; .+1) as $n ([1];
    .[$n] = $n * .[$n-1]);

def lpad($len): tostring | ($len - length) as $l | (" " * $l)[:$l] + .;

def primes: 2, (range(3; infinite; 2) | select(is_prime));


using Primes

function wilsonprimes(limit = 11000)
    sgn, facts = 1, accumulate(*, 1:limit, init = big"1")
    println(" n:  Wilson primes\n--------------------")
    for n in 1:11
        print(lpad(n, 2), ":  ")
        sgn = -sgn
        for p in primes(limit)
            if p > n && (facts[n < 2 ? 1 : n - 1] * facts[p - n] - sgn) % p^2 == 0
                print("$p ")
            end
        end
        println()
    end
end

wilsonprimes()


ClearAll[WilsonPrime]
WilsonPrime[n_Integer] := Module[{primes, out},
  primes = Prime[Range[PrimePi[11000]]];
  out = [email protected][
     If[Divisible[((n - 1)!) ((p - n)!) - (-1)^n, p^2], Sow[p]]
     ,
     {p, primes}
     ];
  First[out[[2]], {}]
 ]
Do[
 Print[WilsonPrime[n]]
 ,
 {n, 1, 11}
]