aparler/RosettaCodeData
1
0
Fork 0
Code Issues 12 Pull requests 3 Projects Releases Packages Wiki Activity Actions

Data update

Browse source
This commit is contained in:
Ingy döt Net 2026-04-30 12:34:36 -04:00
parent 4bb20c9b71
commit cbaf4c4b64
12390 changed files with 318560 additions and 27248 deletions
Download patch file Download diff file Expand all files Collapse all files

71
Task/Abbreviations-automatic/Ada/abbreviations-automatic.adb Normal file
View file

@ -0,0 +1,71 @@
with Ada.Containers.Indefinite_Vectors;
with Ada.Strings.Fixed;
with Ada.Strings.Maps;
with Ada.Text_IO;
procedure Abbreviations is
package String_Vectors is
new Ada.Containers.Indefinite_Vectors (Index_Type => Positive,
Element_Type => String);
use Ada.Text_IO, String_Vectors;
function Split (Line : String) return Vector is
Result : Vector;
First : Natural;
Last : Natural := Line'First - 1;
begin
while Last + 1 in Line'Range loop
Ada.Strings.Fixed.Find_Token
(Line, Ada.Strings.Maps.To_Set (" "), Last + 1,
Ada.Strings.Outside, First, Last);
exit when Last = 0;
Append (Result, Line (First .. Last));
end loop;
return Result;
end Split;
function Abbrev_Length (Items : Vector) return Natural is
use type Ada.Containers.Count_Type;
Max : Natural := 0;
Abbrevs : Vector;
begin
for Item of Items loop
Max := Natural'Max (Max, Item'Length);
end loop;
for Length in 1 .. Max loop
Abbrevs := Empty_Vector;
for Item of Items loop
declare
Last : constant Natural
:= Natural'Min (Item'Last, Item'First + Length - 1);
Abbrev : String renames Item (Item'First .. Last);
begin
exit when Abbrevs.Contains (Abbrev);
Abbrevs.Append (Abbrev);
end;
end loop;
if Abbrevs.Length = Items.Length then
return Length;
end if;
end loop;
return 0;
end Abbrev_Length;
procedure Process (Line : String) is
package Natural_IO is new Ada.Text_IO.Integer_IO (Natural);
Words : constant Vector := Split (Line);
Length : constant Natural := Abbrev_Length (Words);
begin
Natural_IO.Put (Length, Width => 2);
Put (" ");
Put_Line (Line);
end Process;
begin
while not End_Of_File loop
Process (Get_Line);
end loop;
end Abbreviations;

158
Task/Abbreviations-automatic/COBOL/abbreviations-automatic.cob Normal file
View file

@ -0,0 +1,158 @@
IDENTIFICATION DIVISION.
PROGRAM-ID. AUTO-ABBREVIATIONS.
ENVIRONMENT DIVISION.
INPUT-OUTPUT SECTION.
FILE-CONTROL.
SELECT DOW ASSIGN TO "days-of-week.txt"
ORGANIZATION IS LINE SEQUENTIAL.
DATA DIVISION.
FILE SECTION.
FD DOW.
01 DOW-FILE PIC X(200).
WORKING-STORAGE SECTION. *> a.k.a. variables
01 DOW-LINE PIC X(200).
01 ENDO PIC 9(1).
01 ENDO2 PIC 9(1).
01 CURDAY PIC X(50).
01 ABPTR PIC 999.
01 LINE-NUM PIC 9(3) VALUE 1.
01 CHARAMT PIC 9(3) VALUE 1.
01 LARGESTCHARAMT PIC 9(3).
01 DAYNUM PIC 9(3) VALUE 1.
01 ABRESTART PIC 9(1).
01 CURABBR PIC X(50).
01 TMP1 PIC 9(3).
01 TMP2 PIC 9(3).
01 TINDEX PIC 9(3) VALUE 1.
01 ABBRLIST.
05 ABBRITEM PIC X(50) OCCURS 7 TIMES.
PROCEDURE DIVISION.
OPEN INPUT DOW.
PERFORM UNTIL ENDO = 1
READ DOW INTO DOW-LINE
AT END MOVE 1 TO ENDO
NOT AT END PERFORM
*> loop through each line
IF DOW-LINE = "" THEN
DISPLAY ""
ELSE
MOVE 0 TO ENDO2
MOVE 0 TO CHARAMT
PERFORM UNTIL ENDO2 > 0
MOVE 1 TO ABPTR
MOVE 1 TO DAYNUM
MOVE 0 TO ABRESTART
ADD 1 TO CHARAMT
*> reset the abbreviation table
MOVE 1 TO TINDEX
PERFORM 7 TIMES
MOVE SPACE TO ABBRITEM(TINDEX)
ADD 1 TO TINDEX
END-PERFORM
*> loop through each day
PERFORM 7 TIMES
UNSTRING DOW-LINE DELIMITED BY SPACE
INTO CURDAY
WITH POINTER ABPTR
END-UNSTRING
MOVE 0 TO TMP1
MOVE 0 TO TMP2
INSPECT CURDAY
TALLYING TMP1 FOR ALL CHARACTERS
INSPECT CURDAY
TALLYING TMP2 FOR ALL SPACE
SUBTRACT TMP2 FROM TMP1
IF TMP1 > LARGESTCHARAMT THEN
MOVE TMP1 TO LARGESTCHARAMT
END-IF
*> not enough days error
IF CURDAY = "" THEN
MOVE 3 TO ENDO2
END-IF
MOVE CURDAY(1:CHARAMT) TO CURABBR
*> check if the current abbreviation is already taken
MOVE 1 TO TINDEX
PERFORM 7 TIMES
IF ABBRITEM(TINDEX) = CURABBR THEN
MOVE 1 TO ABRESTART
END-IF
ADD 1 TO TINDEX
END-PERFORM
MOVE CURABBR TO ABBRITEM(DAYNUM)
ADD 1 TO DAYNUM
END-PERFORM
IF ABRESTART = 0 THEN
MOVE 1 TO ENDO2
END-IF
*> identical days error
IF CHARAMT > LARGESTCHARAMT THEN
MOVE 2 TO ENDO2
END-IF
END-PERFORM
DISPLAY "Line " LINE-NUM ": " WITH NO ADVANCING
IF ENDO2 = 3 THEN
DISPLAY "Error: not enough " WITH NO ADVANCING
DISPLAY "days"
ELSE IF ENDO2 = 2 THEN
DISPLAY "Error: identical " WITH NO ADVANCING
DISPLAY "days"
ELSE
DISPLAY CHARAMT ": " WITH NO ADVANCING
*> loop through each day and display its abbreviation
MOVE 1 TO TINDEX
PERFORM 7 TIMES
MOVE ABBRITEM(TINDEX) TO CURABBR
MOVE 0 TO TMP1
MOVE 0 TO TMP2
INSPECT CURABBR
TALLYING TMP1 FOR ALL CHARACTERS
INSPECT CURABBR
TALLYING TMP2 FOR TRAILING SPACES
SUBTRACT TMP2 FROM TMP1
DISPLAY CURABBR(1:TMP1) WITH NO ADVANCING
DISPLAY "." WITH NO ADVANCING
IF TINDEX < 7 THEN
DISPLAY SPACE WITH NO ADVANCING
ELSE
DISPLAY X"0a" WITH NO ADVANCING *> go to next line
END-IF
ADD 1 TO TINDEX
END-PERFORM
END-IF
END-IF
END-PERFORM
END-READ
ADD 1 TO LINE-NUM
END-PERFORM.
CLOSE DOW.
STOP RUN.

36
Task/Abbreviations-automatic/Emacs-Lisp/abbreviations-automatic.el Normal file
View file

@ -0,0 +1,36 @@
(defun abbreviate-list (list-of-days abbreviation-length)
"Take each element of LIST-OF-DAYS and abbreviate to ABBREVIATION-LENGTH."
(let ((abbrev-list)
(abbrev-element))
(dolist (one-element list-of-days) ; loop through each day of week
;; if the day of week is at least as long as the abbreviation
(if (>= (length one-element) abbreviation-length) ; if day >= abbreviation length
(setq abbrev-element (substring one-element 0 abbreviation-length)) ; abbreviate the day of the week
(setq abbrev-element one-element)) ; otherwise don't abbreviate
(push abbrev-element abbrev-list)) ; put the abbreviated/non-abbreviated day on our list
abbrev-list)) ; return the list of abbreviated days
(defun cycle-days (list-of-days)
"Find shortest unique abbreviation in LIST-OF-DAYS list."
(let ((abbrev-list)
(abbrev-length 1)
(current-abbrev)
(looking-for-shortest-list t))
(if (= (length list-of-days) 0) ; if list-of-days is empty (i.e., blank line)
(setq looking-for-shortest-list nil)) ; then don't look for the shortest unique abbreviations
(while looking-for-shortest-list ; as long as we are looking for the shortest unique abbreviations
(setq abbrev-list (abbreviate-list list-of-days abbrev-length)) ; get a list of abbreviated day names
(if (= (length list-of-days) (length (seq-uniq abbrev-list))) ; if abbreviated list has no duplicates
(progn
(message (format "%d %s" abbrev-length list-of-days)) ; then in echo buffer show length and days
(setq looking-for-shortest-list nil)) ; also, then don't look for the shortest unique abbreviations
(setq abbrev-length (+ abbrev-length 1)))))) ; else increase the length of the abbreviation; loop to while
(defun days-of-week ()
"Find minimum abbreviation length of days of week."
(let ((current-line-list))
(find-file "Days_of_week.txt") ; open file or switch to buffer
(beginning-of-buffer) ; go to the top of the buffer
(dolist (current-line (split-string (buffer-string) "\n")) ; go line by line through buffer
(setq current-line-list (split-string current-line " ")) ; change each line into list of days of week
(cycle-days current-line-list))))

113
Task/Abbreviations-automatic/Fortran/abbreviations-automatic.f Normal file
View file

@ -0,0 +1,113 @@
!
! Abbreviations, automatic
! tested with Intel ifx (IFX) 2025.2.1 20250806 on Kubuntu 25.10
! GNU Fortran (Ubuntu 15.2.0-4ubuntu4) 15.2.0 on Kubuntu 25.10
! VSI Fortran x86-64 V8.6-001 on OpenVMS x86_64 V9.2-3
! U.B., December 2025
!==============================================================================
program AbbrAuto
integer, parameter :: longestLine = 210 ! Longest input line
integer, parameter :: LongestDay = 30 ! Longest length of 1 day name
character (len=longestLine) :: Line
character (len=LongestDay) :: Days(7) ! 1 week
integer :: l, io_stat
logical :: OK
open (unit=10, file = 'days_of_week.txt', status='old', action='read', iostat=io_stat)
if (io_stat /= 0) then
print *, "Error opening file"
stop
end if
do ! Read all lines
read (10, '(A)', iostat=io_stat) Line
if (io_stat <0) exit ! Normal: EOF on input
if (io_stat >0) then ! Not Normal: Read error
print *, "Read error" ! has never been observed during testing.
exit
end if
call separateDays (Line, Days, OK)
if (OK) then ! 7 week days' name found
print '(I2, X, A)' , smallestAbreviation (Days), Line (:len_trim(Line))
else
print * ! Null string for empty or invalid line
endif
end do ! Read all lines
contains
! =========================================================================================
! Argument argLine contains space-separated list of (expected) 7 names of week days.
! Separate day names into array argDays, OK is .false. if number of days is not exactly 7.
! =========================================================================================
subroutine separateDays (argLine, argDays, OK)
character (len=longestLine), intent(in) :: argLine
character (len=LongestDay) , intent(out) :: argDays(7) ! 1 week
logical, intent(out) :: OK
integer :: ip1, ip2, nDays ! 2 Pointers into line, number of day names detected
integer :: l
ip1 = 1
nDays = 0
l = len_trim (argLine)
do while (ip1 .le. l) ! Loop untill entire line processed.
do while (ip1 .le. l .and. argLine (ip1:ip1) .eq. ' ') ! Skip space(s)
ip1 = ip1 + 1
end do
if (ip1 .le. l) then ! still inside Line?
ip2 = ip1
do while (ip2 .le. l .and. argLine (ip2:ip2) .ne. ' ') ! Find end of current word
ip2 = ip2 + 1
end do
! Here found space or end of line: Word is complete
if (ip2 .gt. l) ip2 = l ! End reached
if (argLine (ip2:ip2) .eq. ' ') ip2 = ip2 - 1 ! Space found
if (ip2 .gt. ip1) then ! day name has at least 2 letters
nDays = nDays + 1
argDays (nDays) = ' '
argDays (nDays) = argLine (ip1:ip2)
endif !
ip1 = ip2 + 1 ! Prepare for next day search: set behind current word
endif
end do
OK = (nDays .eq. 7) ! Result is OK only if number of days is 7
end subroutine separateDays
! =============================================================================
! Find length of smallest abbreviation of 7 day names so that abbreviated name
! is still unique.
! =============================================================================
function smallestAbreviation (argDays) result (nUniq)
character (len=LongestDay) , intent(in) :: argDays(7) ! 1 week
integer :: nUniq
integer :: ii, jj
logical :: done
nUniq = 1
done = .false.
do while (.not. done)
done = .true.
daysLoop: do ii=1, 6
do jj=ii+1,7
if (argDays (ii)(:nUniq) .eq. argDays(jj)(:nUniq)) then
! nUniq is too small for useful abbreviation of week days' name
nUniq = nUniq + 1
done = .false.
exit daysLoop ! go and try tith next larger nUniq
end if
end do
end do daysLoop
! here: done is .true. if no two day names are identical in first 'nUuniq' characters
! otherwise still the abbreviation is still too short
end do
end function smallestAbreviation
end program AbbrAuto

65
Task/Abbreviations-automatic/Pluto/abbreviations-automatic.pluto Normal file
View file

@ -0,0 +1,65 @@
do -- Abbreviatiions automatic - find the minimum abbreviation lengths for days of the week
-- in various languages
require( "uchar" ) -- RC Pluto Unicode character library
-- returns the table of space delimited words in s
local function getWords( s : string ) : table
local t, cmds, w = s, {}, s
while t:contains( " " ) do
w, t = t:partition( " " )
if w != "" then
cmds[ # cmds + 1 ] = w
end
end
if t != "" then
cmds[ # cmds + 1 ] = t
end
return cmds
end
for dow in io.lines( "daysOfWeekNames.txt" ) do
local names <const> = getWords( dow )
if # names == 0 then
io.write( "\n" )
elseif # names != 7 then
error( dow .. ": expected 7 names" )
elseif # names > 0 then
-- try abbreviation lengths up to the minimum word length
local maxLen, uName = -1, {}
for i, n in ipairs( names ) do
uName[ i ] = uchar.of( n )
local thisLen <const> = uName[ i ]:len()
if thisLen > maxLen then
maxLen = thisLen
end
end
local found = false
for abLen = 1, maxLen do
local prefixes <const> = {}
found = true
for nPos = 1, # names do
local subLen <const> = if uName[ nPos ]:len() < abLen
then uName[ nPos ]:len()
else abLen
end
local ab <const> = uName[ nPos ]:sub( 1, subLen )
if prefixes:contains( ab ) then
found = false
break
else
prefixes[ ab ] = ab
end
end
if found then
io.write( string.format( "%2d %s\n", abLen, dow ) )
break
end
end
if not found then
error( "No unique abbreviations for: " .. dow )
end
end
end
end

30
Task/Abbreviations-automatic/Rebol/abbreviations-automatic.rebol Normal file
View file

@ -0,0 +1,30 @@
Rebol [
title: "Rosetta code: Abbreviations, automatic"
file: %Abbreviations,_automatic.r3
url: https://rosettacode.org/wiki/Abbreviations,_automatic
needs: 3.0.0
note: "Based on Red language solution"
]
data: read/lines %abbrev.txt
foreach line data [ ;; split data in lines at carriage return & line feed:
if empty? trim line [
print ""
continue ;; continues at head of loop
]
arr: split line space ;; now split line in words ; accumulate in array / series
min: 1 ;; preset min length
m: make map! []
until [ ;; head is the first position of series
if head? arr [clear m] ;; define an empty map (key -value store)
abbr: copy/part first arr min ;; copy/part ~ leftstr of first word with length min
arr: either m/:abbr [ ;; abbreviation already exists ?
min: min + 1
head arr ;; reset series position to head
][ ;; otherwise ....
m/:abbr: true ;; mark abreviation in map as existent
next arr ;; set series position to next word
]
tail? arr ;; this is the until condition , end /tail of series reached ?
]
print [min line] ;; print automatically reduces all words in block
]

36
Task/Abbreviations-automatic/VBScript/abbreviations-automatic.vbs Normal file
View file

@ -0,0 +1,36 @@
sub print(s) wscript.stdout.writeline s :end sub
set d=createobject("Scripting.Dictionary")
set fso=createobject("Scripting.Filesystemobject")
const fn="weekdays_ansi.txt"
sfn=WScript.ScriptFullName
sfn= Left(sfn, InStrRev(sfn, "\"))
set f=fso.opentextfile(sfn & fn,1)
while not f.atendofstream
s=f.readline
if s=vbNullString then
print " "
else
a=split(trim(s)," ")
for abrlen=1 to 14
d.removeall
for wd=0 to 6
k=left(a(wd),abrlen)
if d.exists(k) then
exit for
else
d.add k,""
end if
next 'wd
if wd>6 then exit for
next 'abrlen
b=right(" " & abrlen,2)
for wd=0 to 6
b=b &" "& left(a(wd),abrlen)
next
print b
end if
wend 'line
f.close