I'm implementing a program in FreePascal in Win10(64-bit). The problem state:
'Given a string, replace all substring 'child' with 'childhood' '
or
'Replace all 'child' with 'childhood''
I try this program
uses crt;
var s, newS : string;
tmp, tmp2, tmp3 : int64;
tmpstr, tmpstr2 : string;
step, step2, step3 : longint;
position : longint;
begin
clrscr;
write('Nhap xau : '); readln(s);
//main mechanism
while pos('child',s) <> 0 do begin
position := pos('child', s);
delete(s, pos('child',1), 5);
insert('childhood',s,position);
inc(position, 9);
newS := '';
for step:=position to length(s) do begin
newS := newS + s[step];
end;
s := newS;
end;
writeln(s);
readkey;
end.
You can see that this part:
inc(position, 9);
newS := '';
for step:=position to length(s) do begin
newS := newS + s[step];
end;
s := newS;
was used to try to cut off the while loop, but it doesn't work. Any idea?
Thanks a lot and have a good day! Thanks for reading this question thread! =)
This is just one of the possibilities, not optimized but perhaps the easiest to understand:
oldstr := 'original child string';
newstr := '';
while oldstr<>'' do begin
// analyze the string from left to right
if copy(oldstr, 1 5)='child' then begin
// match found, perform substitution
newstr := newstr+'childhood';
delete(oldstr, 1, 5)
end else begin
// does not match, go ahead to the next possibility
newstr := newstr+oldstr[1];
delete(oldstr, 1, 1)
end
end
// now newstr is the desired result
The gotcha here was to not analyze again what was added in a previous step (child->childhood). The algorithm above (warning, I've not tested it) ensures that any single char from the original string is checked only once.
Related
In this code, I need help writing a multidimensional array with a range between 2020-01-01 to 2119-12-31.
My code works but as you see there are no arrays in it. How can I write this code with only arrays?
with Ada.Text_IO; use Ada.Text_IO;
with Ada.Integer_Text_IO; use Ada.Integer_Text_IO;
Procedure Date is
type date_type is record
Str : string (1..8);
Length : Natural := 0; end record;
A: date_type;
begin
loop
Put ("Enter a date between 2020-01-01 to 2119-12-31 : ");
Get_Line (A.Str, A.Length);
exit when A.Length = 8;
Put_Line ("Wrong input. Try again.");
end loop;
Put_Line (A.Str (1 .. 4) & "-" & A.Str (5 .. 6) & "-" & A.Str (7 .. 8));
end Date;
Perhaps, rather than a multi-dimensional array you should consider using a record such as
type Year_Number is range 1900..3000;
type Month_Number is range 1..12;
type Day_Number is range 1..31;
type Date_Rec is record
Year : Year_Number;
Month : Month_Number;
Day : Day_Number;
end record;
subtype Year_String is string (1..4);
subtype Month_String is string (1..2);
subtype Day_String is string (1..2);
function To_Date (Yr : Year_String; Mnth : Month_String; Dy : Day_String)
return Date_Rec is
Result : Date_Rec;
begin
Result.Year := Year_Number'Value (Yr);
Result.Month := Month_Number'Value (Mnth);
Result.Day := Day_Number'Value (Dy);
return Result;
end To_Date;
You can now pass around instances of Date_
Rec doing whatever you want with the date.
If you go this far then you might want to consider using the Time type described in Ada Language Reference Manual sections 9.6 and 9.6.1.
You haven't asked a reasonable question here because "I want to use arrays" is not a good reason to use an array.
"This problem can be best solved with an array ... but how do I deal with ... ?" would be a reasonable question, but you haven't stated a problem,let alone one that needs an array.
This is important because "using an array" is thinking in the solution domain, like "using a chisel". It's not the way to think about programming in Ada, (or IMO in any language).
Try thinking in the problem domain first : instead of "I want to use a chisel", I think "I want to recess this hinge so the door fits precisely" and a chisel is the neatest way of doing the job.
Then "How can I best validate a date?" would be one reasonable question, or "how can I store events that happen on each day for 100 years?"
The answer to the first question is probably in the Ada.Calendar package. Possibly the Value function in Ada.Calendar.Formatting, with an exception handler to catch incomprehensible strings and make the user try again.
with Ada.Text_IO; use Ada.Text_IO;
with Ada.Calendar;
with Ada.Calendar.Formatting;
procedure date is
Date : Ada.Calendar.Time;
Done : Boolean;
begin
loop
Put ("Enter a date between 2020-01-01 to 2119-12-31 : ");
Done := TRUE;
declare
A : String := Get_Line & " 12:00:00";
begin
Date := Ada.Calendar.Formatting.Value(A); -- validate it's a date
Done := Ada.Calendar.Year(Date) >= 2020
and Ada.Calendar.Year(Date) < 2120; -- validate correct range
exception
when Constraint_Error => Done := False; -- Formatting.Value failed
end;
exit when Done;
Put("Try Again : ");
end loop;
end date;
The answer to the second is probably a 1-dimensional array indexed by Day_Count from Ada.Calendar.Arithmetic but let's use the wrong tool : a 3D array indexed by your range of years, Month_Number and Day_Number from the Ada.Calendar base package.
with Ada.Text_IO; use Ada.Text_IO;
with Ada.Calendar; use Ada.Calendar;
with Ada.Calendar.Formatting;
with Ada.Strings.Unbounded; use Ada.Strings.Unbounded;
procedure date is
Date : Ada.Calendar.Time;
Done : Boolean := TRUE;
Event_Array : array(2020 .. 2119,
Ada.Calendar.Month_Number,
Ada.Calendar.Day_Number) of Unbounded_String;
begin
Event_Array := (others => (others => (others => Null_Unbounded_String)));
Event_Array(2020,11,3) := To_Unbounded_String("nothing much");
loop
Put ("Enter a date between 2020-01-01 to 2119-12-31 : ");
Done := TRUE;
declare
A : String := Get_Line & " 12:00:00";
begin
Date := Ada.Calendar.Formatting.Value(A);
Done := Ada.Calendar.Year(Date) >= 2020
and Ada.Calendar.Year(Date) < 2120;
exception
when Constraint_Error => Done := False;
end;
exit when Done;
Put("Try Again : ");
end loop;
Put_Line("Today " & Ada.Calendar.Formatting.Image(Date) & " : " &
To_String(Event_Array(Year(Date), Month(Date), Day(Date))) & " happened");
end date;
Test with the string 2020-11-03
I want to correct the last-access time of some files.
Doing that programmatically fails - by one hour - for some files.
Mysterious, as I do correct the date according to the timezone.
Here is an example, tested for Delphi2010 (that's where I would need code for) and Delphi10.3
function GetTempDir : string;
var path : array[0..MAX_PATH] of char;
PathStr : string;
begin
GetTempPath(MAX_PATH, path);
PathStr:=path;
result:=IncludeTrailingPathDelimiter(PathStr);
end;
function UTCDateTimeFromLocalDateTime(const LocalDateTime: TDateTime): TDateTime;
var
LocalSystemTime: TSystemTime;
UTCSystemTime: TSystemTime;
LocalFileTime: TFileTime;
UTCFileTime: TFileTime;
begin
DateTimeToSystemTime(LocalDateTime, UTCSystemTime);
SystemTimeToFileTime(UTCSystemTime, UTCFileTime);
if LocalFileTimeToFileTime(UTCFileTime, LocalFileTime)
and FileTimeToSystemTime(LocalFileTime, LocalSystemTime) then begin
Result := SystemTimeToDateTime(LocalSystemTime);
end else begin
Result := LocalDateTime;
end;
end;
function SetFileTimesHelper(const FileName: string; DateTime: TDateTime): Boolean;
var
Handle: THandle;
FileTime: TFileTime;
SystemTime: TSystemTime;
begin
Result := False;
Handle := CreateFile(PChar(FileName), GENERIC_WRITE, FILE_SHARE_READ, nil,
OPEN_EXISTING, 0, 0);
if Handle <> INVALID_HANDLE_VALUE then
try
DateTime:=UTCDateTimeFromLocalDateTime(DateTime);
DateTimeToSystemTime(DateTime, SystemTime);
FileTime.dwLowDateTime := 0;
FileTime.dwHighDateTime := 0;
if SystemTimeToFileTime(SystemTime, FileTime) then
begin
Result := SetFileTime(Handle, nil, nil, #FileTime);
end;
finally
CloseHandle(Handle);
end;
end;
procedure TForm1.CreateDateFile(Dat : TDateTime);
var FileName : string;
begin
FileName:=GetTempDir+FormatDateTime('yyyymmdd hhnnss', Dat)+'.txt';
Memo1.Lines.Add(FileName);
with TStringList.Create do
begin
text:='1';
SaveToFile(FileName);
Free;
end;
SetFileTimesHelper(FileName, Dat);
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
CreateDateFile(StrToDateTime('23.02.2013 11:11:11'));
CreateDateFile(StrToDateTime('06.05.2014 22:22:22')); // file dated 23:22:22
end;
The first file is correctly dated, the 2nd is displayed in the windows explorer with 23:22:22.
What do I miss?
Thanks brian for the comment.
Digging that way I found a solution:
GetTimeZoneInformation(tz);
SystemTimeToTzSpecificLocalTime(#tz, UTCSystemTime, LtSystemTime);
I didn't find the inverse function of SystemTimeToTzSpecificLocalTime, but I used this function and then see the resulting offset. Then I invert the offset and the time is properly corrected.
Let me start by saying this is the first ada program I have ever created. I have no idea how it works, and my assignment is incredibly simple. However, the output is not working correctly. It works with the first variable, but not with the next two. It also prints the first variable weird. Here is my code:
with Ada.Text_IO; use Ada.Text_IO;
procedure Main is
Author, Title, Pages: String := " ";
begin
Put("Enter Author: ");
Get(Author);
Put("Enter Title: ");
Get(Title);
Put("Enter number of pages: ");
Get(Pages);
Put("Author: ");
Put(Author);
New_Line;
Put("Title: ");
Put(Title);
New_Line;
Put("Number of pages: ");
Put(Pages);
end Main;
The goal is simply to enter information about a book and the program reads it out to you. This is the output:
Enter Author: john
Enter Title: Enter number of pages: Author: j
Title: o
Number of pages: h
Side note, I couldn't get page numbers to work as an integer. The get and put methods just gave errors. That isn't important but if anyone can help make that an integer I would appreciate it.
Here's a possible solution:
with Ada.Text_IO;
procedure Text_Input is
type Page_Count is range 1 .. 10_000;
package Page_Count_Text_IO is new Ada.Text_IO.Integer_IO (Page_Count);
function Get_Line (Message : in String) return String;
function Get_Line (Message : in String) return Page_Count;
function Get_Line (Message : in String) return String is
begin
Ada.Text_IO.Put (Message);
return Ada.Text_IO.Get_Line;
end Get_Line;
function Get_Line (Message : in String) return Page_Count is
begin
return Result : Page_Count do
Ada.Text_IO.Put (Message);
Page_Count_Text_IO.Get (Result);
if Ada.Text_IO.Get_Line /= "" then
raise Constraint_Error
with "Page count followed by extra characters.";
end if;
end return;
end Get_Line;
Author : constant String := Get_Line ("Enter author: ");
Title : constant String := Get_Line ("Enter title: ");
Pages : constant Page_Count := Get_Line ("Enter number of pages: ");
begin
Ada.Text_IO.Put_Line ("Author: " & Author);
Ada.Text_IO.Put_Line ("Title: " & Title);
Ada.Text_IO.Put_Line ("Number of pages:" & Page_Count'Image (Pages));
end Text_Input;
Notice that I've made the Get_Line function for Page_Count check that you don't have any trailing garbage on the line, where you enter the number of pages.
I hope you don't disagree with my estimate that John will never write a single book of more than 10'000 pages. :-)
I am planning to convert some programs written in C/C++ to Ada.
These make heavy use of constant char literals often as ragged arrays like:
const char * stringsA = { "Up", "Down", "Shutdown" };
or string references in records like:
typedef struct
{
int something;
const char * regexp;
const char * errormsg
} ERRORDESCR;
ERRORDESCR edscrs [ ] =
{
{ 1, "regexpression1", "Invalid char in person name" },
{ 2, "regexp2", "bad bad" }
};
The presets are calculated by the C/C++ compiler and I want the Ada compiler to be
able to do that too.
I used Google and searched for ragged arrays but could only find two ways of
presetting the strings. One in Rationale for Ada 95 by John Barnes and another
at http://computer-programming-forum.com/44-ada/d4767ad6125feac7.htm.
These are shown as stringsA and stringsB below.
StringsA is defined in two stages, which is a bit tedious if there are hundreds
of strings to set up. StringsB uses one step only, but is compiler dependent.
Question 1: are there other ways?
Question 2: would the second stringsB work with GNAT Ada?
I have not started converting. The packages below are just for experimenting
and teaching myself...
package ragged is
type String_ptr is access constant String;
procedure mydummy;
end ragged;
package body ragged is
s1: aliased constant String := "Up";
s2: aliased constant String := "Down";
s3: aliased constant String := "Shutdown";
stringsA: array (1 .. 3) of String_ptr :=
(s1'Access, s2'Access, s3'Access); -- works
stringsB: array (1 .. 3) of String_ptr :=
(new String'("Up"), new String'("Down"),
new String'("Shutdown")); -- may work, compiler-dependent
-- this would be convenient and clear...
--stringsC: array (1 .. 3) of String_ptr :=
-- ("Up", "Down", "Shutdown"); -- BUT Error, expected String_ptr values
--stringsD: array (1 .. 3) of String_ptr :=
--("Up"'Access, "Down"'Access, "Shutdown"'Access); --Error - bad Access use
--stringsE: array (1 .. 3) of String_ptr :=
--(String_ptr("Up"), String_ptr("Down"),
-- String_ptr("Shutdown")); -- Error, invalid conversion
procedure mydummy is
begin
null;
end;
end ragged;
A little judicious operator overloading can do this in a less cluttered manner:
(Within the package body)
function New_String(S : String) return String_Ptr is
begin
return new String'(S);
end New_String;
function "+" (S : String) return String_Ptr renames New_String;
Now you can do:
stringsC: array (1 .. 3) of String_ptr := (+"Up", +"Down", +"Shutdown");
Not enough space in comment for this
Test program
package raggedtest is
type String_ptr is access constant String;
procedure mytest;
end raggedtest;
with ada.text_IO; use Ada.Text_IO;
package body raggedtest is
s1: aliased constant String := "Up";
s2: aliased constant String := "Down";
s3: aliased constant String := "Shutdown";
stringsA: array (1 .. 3) of String_ptr :=
(s1'Access, s2'Access, s3'Access);
stringsB: array (1 .. 3) of String_ptr :=
(new String'("UpB"), new String'("DownB"),
new String'("ShutdownB"));
function New_String(S : String) return String_Ptr is
begin
return new String'(S);
end New_String;
function "+" (S : String) return String_Ptr renames New_String;
stringsC: array (1 .. 3) of String_ptr := (+"UpC", +"DownC", +"ShutdownC");
procedure mytest is
begin
put ( "s1A: " ); put( stringsA(1).all ); New_line;
put ( "s2A " ); put( stringsA(2).all ); New_line;
put ( "s3A: " ); put( stringsA(3).all ); New_line;
put ( "s1B: " ); put( stringsB(1).all ); New_line;
put ( "s2B " ); put( stringsB(2).all ); New_line;
put ( "s3B: " ); put( stringsB(3).all ); New_line;
put ( "s1C: " ); put( stringsC(1).all ); New_line;
put ( "s2C " ); put( stringsC(2).all ); New_line;
put ( "s3C: " ); put( stringsC(3).all ); New_line;
end;
end raggedtest;
with raggedtest; use raggedtest;
procedure main is
begin
mytest;
end main;
I'm trying to run this code, but something is going wrong with the line:
Soldiers (Number_Of_Soldiers) := Soldier_Type'(Name=>new String'(Line(1..Length)), Alive=>True);
Can someone help me, please?
Thank you so much!
--Josephus Problem
with Ada.Text_IO,Ada.Integer_Text_IO;
use Ada;
procedure Josephus is
type String_Pointer is access String;
type Soldier_Type is record
Name : String_Pointer;
Alive : Boolean;
end record;
Max_Number_Of_Soldiers: constant := 10;
Number_Of_Soldiers : Integer range 0..Max_Number_Of_Soldiers := 0;
-- start with 0 to facilitate modular arithmetic
Soldiers: array (0..Max_Number_Of_Soldiers-1) of Soldier_Type;
procedure Next (Index: in out Integer; Interval: Positive) is
begin
for I in 1..Interval loop
loop
Index := (Index + 1) mod Number_Of_Soldiers;
exit when Soldiers(Index).Alive;
end loop;
end loop;
end Next;
Interval : Integer;
Man : Integer := Soldiers'First;
begin
-- get interval from the standard input
Integer_Text_IO.Get (Interval);
Text_IO.Skip_Line;
Text_IO.Put ("Skip every ");
Integer_Text_IO.Put (Interval, Width=>1);
Text_IO.Put_Line (" soldiers.");
-- get names (one per line) from the standard input
declare
Line: String (1..10);
Length: Integer;
begin
while not (Text_IO.End_Of_File) loop
Text_IO.Get_Line (Line, Length);
Soldiers (Number_Of_Soldiers) := Soldier_Type'(Name=>new String'(Line(1..Length)), Alive=>True);
Number_Of_Soldiers := Number_Of_Soldiers + 1;
end loop;
end;
for I in 1..Number_Of_Soldiers-1 loop
Soldiers(Man).Alive := False;
Text_IO.Put (Soldiers(Man).Name.all);
Text_IO.Put_Line (" commits suicide.");
Next (Man, Interval);
end loop;
Text_IO.Put (Soldiers(Man).Name.all);
Text_IO.Put_Line (" is the last.");
end Josephus;
I think your problem is with the line
Max_Number_Of_Soldiers: constant := 10;
Obviously the number specified needs to be more than the maximum possible number of entries in your input!
The problem of unbounded input data sets is one reason to look at using Ada.Containers.Vectors instead of arrays.