Xâu kí tự, chuỗi

Bài 1: Nhập xâu kí tự bất kì 

a) Đếm số lần xuất hiện của 1 kí tự nào đó trong câu.

b) Liệt kê các kí tự có mặt trong xâu cùng số lần xuất hiện của các kí tự đó.

Uses crt;

var str:string[100];   

chu: array[#1..#254] of integer;   

i: integer; ch:char;

Begin

clrscr;

for ch:=#1 to #254 do chu[ch]:=0;

write(' Nhap chuoi = ');readln(str);

for i:=1 to length(str) do

(chu[upcase(str[i])]):=chu[upcase(str[i])] +1;

writeLn('Cac ki tu trong xau la:');

for ch:=#1 to #254 do

if chu[ch]>0 then writeln(ch, ': xuat hien ',chu[ch],' lan');

readln;

end.

Bài 2: Nhập 1 xâu kí tự.

a) Xét xem trong xâu có K kí tự kề nhau mà như nhau hay không?

b) Hãy xóa đi kí tự kề nhau mà như nhau, chỉ giữ lại một.

uses crt;

var ch:string[100];

   i,k,d,d1,n:integer;

//------------------------

Function xoa:boolean;

var i:integer;

begin

    xoa:=false;

    for i:=1 to length(ch)-1 do

    if ch[i]=ch[i+1] then

    begin

         delete(ch,i,1);

         xoa:=true;

         exit

    end;

end;

//-------------------------

Begin

clrscr;

      write('Nhap chuoi :');readln(ch);

      write('Nhap ki tu K:');readln(k);

      n:=length(ch);

      d:=0;d1:=0;

      for i:=1 to n-1 do

      begin

           if ch[i]=ch[i+1] then inc(d1)

           else d1:=0;

           if d1+1>=k then inc(d);

      end;

      if d>0 then writeln('Co ',k,' ki tu nhu nhau')

      else writeln('Khong co ',k,' ki tu nhu nhau');

      while xoa do;

      write('In lai xau sau khi xoa:');

      writeln(ch);

readln;

end.

Bài 3: Nhập 1 xâu kí tự. Kiểm tra tính đối xứng của xâu đó. Nếu xâu không đối xứng thì đảo xâu.

uses crt;

var str,s:string[100];

n,i:integer;

//----------------------------

procedure sx(var a,b:char);

var tam:char;

begin

    tam:=a;

    a:=b;

    b:=tam;

end;

procedure dao(n,i:integer);

var j:integer;

begin

    for j:=i+1 to n do

        if str[i]=str[j] then

           begin

                sx(str[j],str[n-i+1]);

                exit

           end;

end;

//----------------------

begin

clrscr;

      write('Nhap xau:');readln(str);

      n:=length(str);

      s:='';

      for i:=n downto 1 do s:=s+str[i];

      if str=s then writeln('Chuoi doi xung:')

      else

          begin

               writeln('Chuoi ko doi xung, chuoi da dao doi xung:');

               for i:=1 to n-1 do

                   dao(n,i);

          end;

          writeln(str);

readln;

end.

Bài 4: Cho 1 xâu kí tự. Tính xem trong số đó có bao nhiêu loại kí tự khác nhau ( không phân biệt in hoa hay in thường).

uses crt;

var s:string;

i,j,dem:integer;

t:boolean;

begin

clrscr;

      write('Nhap xau:');readln(s);

      dem:=0;

      for i:=1 to length(s) do

      begin

           t:=false;

           for j:=1 to i-1 do

               if((s[j])=(s[i])) then t:=true;

           if not(t) then inc(dem);

      end;

      write('Co ',dem,' ki tu khac nhau.');

readln;

end.

Bài 5: Cho 1 xâu kí tự bất kì, tính:

a) Số lượng các kí tự số.

b) Số lượng các kí tự chữ cái.

uses crt;

const so: set of char=['0','1','2','3','4','5','6','7','8','9'];

var st,b:string;

   a:array[1..100] of integer;

   i,j,l,n,dem,dem1,c:integer;

//------------------------

procedure sx(var x,y:integer);

var tam:integer;

begin

    tam:=x;

    x:=y;

    y:=tam;

end;

//-------------------------

begin

clrscr;

      write('Nhap xau:');readln(st);

      dem:=0;

      dem1:=0;

      for i:=1 to length(st) do

      begin

           if (st[i] in['0'..'9']) then inc(dem);

           if (upcase(st[i]) in['A'..'Z']) then inc(dem1);

      end;

      write('Co ',dem1,' chu cai.');

      writeln;

      writeln('Co ',dem,' chu so.');

      l:=length(st); i:=1; n:=0;

      repeat

            if (st[i] in so) then

               begin

                    b:='';

                    repeat

                          b:=b+st[i];

                          inc(i);

                    until (not(st[i] in so)) or (i>l);

                    inc(n);

                    val(b,a[n],c);

               end;

            inc(i);

      until i>l;

      for i:=1 to n do write(a[i]:5);

      writeln;

      writeln('Sx tang:');

      for i:=1 to n-1 do

      for j:=i to n do

      if a[j]<a[i] then sx(a[j],a[i]);

      for i:=1 to n do write(a[i]:5);

readln;

end.

Bài 6: Cho 1 xâu kí tự bất kì (cả số lẫn chữ). Viết chương trình tách các phần là số của xâu trên và đưa ra 1 mảng số nguyên.

uses crt;

const so: set of char=['0','1','2','3','4','5','6','7','8','9'];

var a:array[1..100] of integer;

st,b:string;

c,l,i,n,j:integer;

//--------------------

procedure sx(var x,y:integer);

var tam:integer;

begin

    tam:=x;

    x:=y;

    y:=tam;

end;

//-------------------

begin

clrscr;

      write('Nhap xau:');readln(st);

      l:=length(st); i:=1; n:=0;

      repeat

            if (st[i] in so) then

               begin

                    b:='';

                    repeat

                          b:=b+st[i];

                          inc(i);

                    until (not(st[i] in so)) or (i>l);

                    inc(n);

                    val(b,a[n],c);

               end;

            inc(i);

      until i>l;

      for i:=1 to n do write(a[i]:5);

      writeln;

      write('Sx tang:');

      writeln;

      for i:=1 to n-1 do

      for j:=i to n do

      if a[j]<a[i] then sx(a[j],a[i]);

      for i:=1 to n do write(a[i]:5);

readln;

end.

Bài 7: Nhập vào 1 xâu. Biến đổi thành chữ in hoa.

uses crt;

var s:string;

   i,k:integer;

begin

clrscr;

      write('Nhap xau:');readln(s);

      write('Bien doi in hoa:');

      for i:=1 to length(s) do

      write(upcase(s[i]));

readln;

end.

Bài 8: Nhập vào 1 xâu. Biến đổi in thường.

uses crt;

var s:string;

   i:integer;

begin

clrscr;

      write('Nhap xau:');readln(s);

      for i:=1 to length(s) do

      if s[i] in ['A'..'Z'] then s[i]:=chr(ord(s[i])+32);

      write('Bien doi thuong:',s);

readln;

end.

Bài 9: Nhập vào 1 chuỗi, in ra chuỗi ngược.

uses crt;

var s:string;

   i:integer;

begin

clrscr;

      write('nhap chuoi:');readln(s);

      write('Chuoi nguoc:');

      for i:=length(s) downto 1 do write(s[i]);

readln;

end.

Bài 10: Nhập vào danh sách HS 1 lớp. Sắp xếp lại danh sắp theo thứ tự tăng dần theo  chiều dài của tên.

uses crt;

var hs:string;

   i,j,n:integer;

//---------------------------

procedure sx(var a,b:integer);

var tam:integer;

begin

    tam:=a;

    a:=b;

    b:=tam;

end;

//---------------------------

begin

clrscr;

      write('Nhap so HS:');readln(n);

      for i:=1 to n do

      begin

           write('Ten HS thu ',i,' :');readln(hs[i]);

      end;

      for i:=1 to n-1 do

          for j:=i+1 to n do

          if length(hs[i]) > length(hs[j]) then sx(hs[i],hs[j]);

          writeln('Sx theo do dai ten:');

          for i:=1 to n do writeln(hs[i]);

readln;

end.

Bài 11: Nhập vào họ tên bất kì sau đó biến đổi các chữ cái đầu tiên là in hoa.

uses crt;

const chu=['a'..'z'];

     var hoten:string;

         i,k:integer;

begin

clrscr;

      write('Nhap ho ten:');readln(hoten);

      k:=length(hoten);

      if hoten[1] in chu then hoten[1]:=upcase(hoten[1]);

      for i:=2 to k do

          if (hoten[i-1]=#32) and (hoten[i] in chu) then

          hoten[i]:=upcase(hoten[i]);

      write('sau khi bien doi:',hoten);

readln;

end.

Bài 12: Nhập vào 1 đoạn văn. Tính số câu.

uses crt;

var s:string;

   i,d:integer;

begin

clrscr;

      write('Nhap 1 doan:');readln(s);

      for i:=1 to length(s) do

      if s[i]='.' then inc(d);

      write('Doan tren co ',d,' cau.');

readln;

end.

Bài 13: Nhập vào 1 số, xóa bỏ các chữ số lẻ. Xuất kết quả dưới dạng đối xứng của phần còn lại.

Vd:  12456 --> 246642

Bài giải:

uses crt;

const so=['1','3','5','7','9'];

var s:string;

   i:integer;

begin

clrscr;

      write('Nhap 1 day so:');readln(s);

      i:=1;

      while i<=length(s) do

      if s[i] in so then

      begin

           delete(s,i,1);

           i:=1;

      end

       else inc(i);

      write('Sau khi xoa cac so le va bien doi doi xung:',s);

      for i:=length(s) downto 1 do write(s[i]);

readln;

end.

Bài 14: Nhập vào 1 số, xóa bỏ các chữ số chẵn. Kiểm tra số còn lại có bao nhiêu chữ số. Xuất kết quả dưới dạng đối xứng của phần còn lại.

Uses crt;

const so=['0','2','4','6','8'];

var s:string;

   i,dem:integer;

Begin

clrscr;

      dem:=0;

      write('Nhap 1 day so:');readln(s);

      i:=1;

      while i<= length(s) do

      if s[i] in so then

      begin

           delete(s,i,1);

           i:=1;

      end

       else inc(i);

      for i:=1 to length(s) do dem:=dem+1;

    writeln('Sau khi xoa cac so chan con ',dem,' so le .');

    write('Sau khi xoa cac so chan va bien doi doi xung :',s,' ');

      for i:=length(s) downto 1 do write(s[i]);

Readln;

End.

Bài 15: Nhập chuỗi gồm cả chữ và số. Xuất ra màn hình các số riêng và các chữ riêng. Hãy đếm số lần xuất hiện của mỗi chữ, mỗi số.

Uses crt;

var s:string;

   dem:array[#1..#254] of integer;

   i:integer;

   chu:char;

begin

    clrscr;

    write('Nhap chuoi gom chu va so:');readln(s);

    for chu:=#1 to #254 do dem[chu]:=0;

    writeln('Chu:');

    for i:=1 to length(s) do

        if upcase(s[i]) in ['A'..'Z'] then

           begin

                write(s[i]);

                dem[upcase(s[i])]:=dem[upcase(s[i])] +1;

           end;

    writeln;

    writeln('So:');

    for i:=1 to length(s) do

        if s[i] in ['0'..'9'] then

           begin

                write(s[i]);

                dem[s[i]]:=dem[s[i]] +1;

           end;

    writeln;

    for chu:=#1 to #254 do

        if dem[chu]<>0 then writeln(chu,' xuat hien ',dem[chu],' lan');

    readln;

End.

Bài 16: Nhập 1 xâu kí tự và bỏ đi tất cả các khoảng trống bên trái của nó.

Uses crt;

var s,t:string;

   i,p:integer;

begin

    clrscr;

    write('Nhap chuoi:');readln(s);

    writeln('khoang trong ben trai cua chuoi da bo, chuoi:');

    while s[1]=#32 do delete(s,1,1);

    write(s);

    readln;

End.

Bài 17:  Dùng hàm “copy”. Tách từ đầu tiên ra khỏi 1 xâu kí tự cho trước.

Uses crt;

var s:string;

   i:integer;

begin

    clrscr;

    write('Nhap chuoi:');readln(s);

    writeln('Tach tu dau tien ra khoai xau:');

    write(copy(s,1,1));

    readln;

End.

Bài 18. Viết chương trình Pascal Đảo ngược một chuỗi

Program Dao_Chuoi;

Var

St:String;

i:Byte;

Begin

Writeln('DAO NGUOC MOT CHUOI');

Writeln('   -----------');

Write('-Nhap chuoi: ');

Read(St);

Writeln;

Write('+Chuoi dao : ');

For i:= Length(St) DownTo 1 Do

Write(St[i]);

Writeln;

Writeln;

Writeln('   Bam phim <Enter> de ket thuc');

Readln;

Readln

End.

Bài  19. Viết chương trình Pascal Tách chuỗi con từ chuỗi mẹ

Program Tach_chuoi;

Var

St:String;

Pos,Num:Byte;

Begin

Writeln('TACH CHUOI CON TU CHUOI ME');

Writeln('         Ham Copy');

Writeln('     ---------------');

Write('-Nhap chuoi: ');

Readln(St);

Write('-Tach tu vi tri: ');

Readln(Pos);

Write('-Bao nhieu ky tu: ');Readln(Num);

Writeln;

Writeln('+Chuoi con la: ',Copy(St,Pos,Num));

Writeln;

Writeln('         Bam phim <Enter> de ket thuc');

Readln

End.

 Bài 20.  Viết chương trình Pascal Tìm vị trí chuỗi con trong chuỗi mẹ

Program Vi_Tri_Chuoi;

Var

St1,St2:String;

Begin

Writeln('VI TRI CHUOI CON TRONG CHUOI ME');

Writeln('         Ham Pos');

Writeln('     --------------');

Write('-Chuoi  me: ');

Readln(St1);

Write('-Chuoi con: ');

Readln(St2);

Writeln('+Chuoi con bat dau tu vi tri thu: ',Pos(St2,St1),' trong chuoi me');

Writeln;

Writeln('       Bam phim <Enter> de ket thuc');

Readln

End.

Bài 21. Viết chương trình Pascal Kiểm tra chuỗi đối xứng

Program Chuoi_Doi_Xung;

Var St:String;  i,l:Byte;

Begin

Writeln('CHUOI DOI XUNG');

Writeln('   --------');

Write('-Nhap chuoi: ');

Readln(St);

l:=Length(St);

i:=1;

While (i < l Div 2) And (St[i] = St[l-i+1]) Do

Begin

i:=i+1;

If i < (l Div 2) Then

Writeln('+Chuoi nay doi xung')

End;

While (i < l Div 2) And (St[i] <> St[l-i+1]) Do

Begin

i:=i+1;

If i < (l Div 2) Then

Writeln('+Chuoi nay khong doi xung')

End;

Writeln;

Writeln('    Bam phim <Enter> de ket thuc');

Readln

End.

Bài 22. Viết chương trình Pascal Đếm số lần xuất hiện của ký tự trong chuỗi

Program Dem_xuat_hien_ki_tu;

Var St:String;

dem:ARRAY['A'.. 'Z'] Of Integer;

i:Integer; Ch:Char;

Begin

Writeln('DEM SO LAN XUAT HIEN CUA KY TU TRONG CHUOI');

Writeln('    -----------');

Write('-Nhap chuoi: ');

Readln(St);

For i:=1 To Length(St) Do

Dem[UpCase(St[i])]:= Dem[UpCase(St[i])]+1;

Writeln;

Writeln('+Cac ky tu trong chuoi la: ');

For Ch:='A' To 'Z' Do

If Dem[ch] > 0 Then

Writeln('+Chu: ',Ch,' co: ',Dem[Ch],' ky tu' );

Writeln;

Writeln('Bam phim <Enter> de ket thuc');

Readln

End.

Bài 23. Viết chương trình Pascal Đếm số từ trong chuỗi:

Program Dem_Tu;

Var St:String;

//------------------------------------

Function Sochu(Dong:String):Integer;

Var dem,i:Integer;

Begin

Dem:=0;

i:=1;

Repeat

While ((UpCase(Dong[i]) < 'A') Or (UpCase(Dong[i]) >'Z'))

And (I <=Length(Dong)) Do

i:=i+1;

If i <= Length(Dong) Then

Dem:=Dem + 1;

While ((UpCase(Dong[i]) >= 'A') And (UpCase(Dong[i]) <= 'Z'))

And (I <=Length(Dong)) Do

i:=i+1;

Until i > Length(Dong);

Sochu:=Dem;

End;

//------------------------------------

Begin

Write('-Nhap mot cau ca dao tuc ngu: ');

Readln(St);

Writeln('-Cau nay co: ',Sochu(St),' tu');

Readln

End.

Bài 24. Viết chương trình Pascal đổi số ra chữ

Program Doi_So_Ra_Chu;

Var Tiep:Char; Chuoitk,Chuoikq:String;So:[0..999];

Tram,Chuc,Donvi:0..9;

BEGIN

Tiep:='C';

While UpCase(Tiep)='C' Do

Begin

Chuoitk:='MOT HAI BA  BON NAM SAU BAY TAM CHIN';

Write('-Nhap so can doi: ');

Readln(so);

If So = 0 Then

Writeln('So khong')

Else

Begin

Tram:=So Div 100;

Chuc:=(So-Tram * 100) Div 10;

Donvi:= So Mod 10;

Chuoikq:=' ';

If (Donvi > 0) And (Donvi <> 5) Then  Chuoikq :=Chuoikq + Copy(Chuoitk,4* Donvi -3,4);

If (Donvi = 5) And (Chuc = 0) Then  Chuoikq :=Chuoikq + ' NAM';

If (Donvi = 5) And (Chuc > 0) Then  Chuoikq := Copy(Chuoitk,4 * Chuc-3,4)+' LAM';

If (Donvi = 5) And (Chuc = 1) Then  Chuoikq := ' LAM';

If Chuc = 1 Then Chuoikq:='MUOI'+chuoikq;

If (Chuc > 1) And (Donvi = 0) Then  Chuoikq:=Copy(Chuoitk,4 * Chuc-3,4)+' MUOI ';

If (Chuc > 1) And (Donvi = 1) Then  Chuoikq:=Copy(Chuoitk,4 * Chuc-3,4)+' MUOI '+Chuoikq;

If (Chuc > 1) And (Donvi > 1) And (Donvi <>5)Then  Chuoikq:=Copy(Chuoitk,4 * Chuc-3,4)+' MUOI '+Chuoikq;

If (Tram > 0) And (Chuc=0) And (Donvi=0) Then  Chuoikq:=Copy(Chuoitk,4*Tram-3,4)+' TRAM ';

If (Tram > 0) And (Chuc = 0) And (Donvi > 0) Then  

            Chuoikq := Copy(Chuoitk,4*Tram-3,4)+' TRAM LINH '+ Copy(Chuoitk,4*Donvi-3,4);  

If (Tram > 0) And (Chuc = 1) And (Donvi = 0) Then

            Chuoikq := Copy(Chuoitk,4*Tram-3,4)+ 'TRAM MUOI';

If (Tram > 0) And (Chuc >= 2) And (Donvi = 0)Then

            Chuoikq := Copy(Chuoitk,4*Tram-3,4)+' TRAM '+ Copy(Chuoitk,4*Chuc -3,4) +' MUOI';

If (Tram > 0) And (Chuc <> 0) And (Donvi > 0)Then

          Chuoikq := Copy(Chuoitk,4*Tram-3,4)+' TRAM '+ Copy(Chuoitk,4*Chuc -3,4) +' MUOI '+

          Copy(Chuoitk,4*Donvi-3,4);

If (Tram > 0) And (Chuc <> 0) And (Donvi = 5)Then

           Chuoikq := Copy(Chuoitk,4*Tram-3,4)+' TRAM '+ Copy(Chuoitk,4*Chuc -3,4) +' MUOI LAM';

Write('-Viet bang chu la: ',Chuoikq);

End;

Writeln;

Write('+Tiep tuc nua khong (C/K) ');

Readln(Tiep);

End;

END.

Bài 25. Viết chương trình Pascal Tạo chữ chạy tên màn hình

Program Chu_Chay;

Uses Crt;

Const

a='Nhom Tin hoc tre Thanh Dong nam 2022  ';

b='Truong THCS Thanh Dong - Binh Tan - Vinh Long   ';

c=’Men chao quy thay co va cac ban gan xa';

d='Chan thanh cam on quy thay co va cac ban da ghe tham';

Function Lap(Kt:Char; N:Integer): String;

Var

Tam:String;

K:Integer;

Begin

Tam:=' ';

For K:=1 To N Do

Tam:=Tam+Kt;

Lap:=Tam;

End;

{--------------}

Procedure WriteXY(X,Y:Integer; St:String);

Begin

GotoXY(X,Y);

Write(St);