Home > Free Pascal, UwB > Laborki z Pascala – Lista 7

Laborki z Pascala – Lista 7

Styczeń 3rd, 2010 Katharsis Zostaw komentarz Idź do komentarzy

Z dużym poślizgiem, ale są! W dzisiejszej notce udostępniam rozwiązania zadań z Listy 7.

Laboratorium 7

Zadanie 1

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32

PROGRAM lista7_zad1(INPUT, OUTPUT);
 
USES
	CRT;
 
VAR
	wymiar, x, y : INTEGER;
	macierz : ARRAY OF ARRAY OF INTEGER;
 
BEGIN
	CLRSCR;
 
	WRITE('Podaj wymiar miacierzy: ');
	READLN(wymiar);
 
	SETLENGTH(macierz, wymiar, wymiar);
 
	WRITELN;
 
	FOR x := 0 TO (wymiar - 1) DO
		BEGIN
			FOR y := 0  TO (wymiar - 1) DO
				BEGIN
					macierz[x][y] := (x + 1) * (y + 1);
					WRITE(macierz[x][y]:4);
				END;
 
			WRITELN;
		END;
 
	REPEAT UNTIL KEYPRESSED;
END.

Wypełniam iloczynem liczb macierz, o podanym przez użytkownika rozmiarze. Aby zachować dynamikę rozwiązania, korzystam ze znanego już typu danych, jakim są tablice dynamiczne.

Zadanie 2

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58

PROGRAM lista7_zad2(INPUT, OUTPUT);
 
USES
	CRT;
 
VAR
	n, m, przedzial, x, y, min, suma : INTEGER;
	macierz : ARRAY OF ARRAY OF INTEGER;
 
BEGIN
	CLRSCR;
 
	WRITE('Podaj wymiary macierzy NxM: ');
	READLN(n, m);
 
	WRITE('Podaj końcowy przedział liczb losowych: ');
	READLN(przedzial);
 
	SETLENGTH(macierz, n, m);
	RANDOMIZE;
 
	WRITELN;
 
	FOR x := 0 TO (n - 1) DO
		BEGIN
			FOR y := 0  TO (m - 1) DO
				BEGIN
					macierz[x][y] := RANDOM(przedzial) + 1;
					WRITE(macierz[x][y]:4);
				END;
 
			WRITELN;
		END;
 
	suma := 0;
 
	FOR y := 0 TO (m - 1) DO
		BEGIN
			min := przedzial + 1;
 
			FOR x := 0 TO (n - 1) DO
				BEGIN
					IF macierz[x][y] < min THEN
						min := macierz[x][y]
 
					ELSE
						CONTINUE;
				END;
 
			suma := suma + min;
		END;
 
	WRITELN;
 
	WRITELN('Wynik: ', suma);
 
	REPEAT UNTIL KEYPRESSED;
END.

Zadanie podobne do powyższego, z tym, że tutaj elementami macierzy są liczy losowe. Dalsza część programu odpowiedzialna jest za znalezienie najmniejszych elementów w poszczególnych kolumnach naszej macierzy, a nastepnie podliczenie sumy wszystkich wyników.

Zadanie 3

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22

PROGRAM lista7_zad3(INPUT, OUTPUT);
 
USES
	CRT;
 
VAR
	lancuch : STRING;
	x : INTEGER;
 
BEGIN
	CLRSCR;
 
	WRITE('Wprowadź łańcuch znaków: ');
	READLN(lancuch);
 
	WRITELN;
 
	FOR x := LENGTH(lancuch) DOWNTO 1 DO
		WRITE(lancuch[x]);
 
	REPEAT UNTIL KEYPRESSED;
END.

Wypisuję podany łańcuch znaków w odwrotnej kolejności.

Zadanie 4

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37

PROGRAM lista7_zad4(INPUT, OUTPUT);
 
USES
	CRT;
 
VAR
	lancuch : STRING;
 
	FUNCTION ZmienZnak(str : STRING; pre, pos : CHAR) : STRING;
		VAR
			x : INTEGER;
 
		BEGIN
			FOR x := 1 TO LENGTH(lancuch) DO
				BEGIN
					IF lancuch[x] = pre THEN
						lancuch[x] := pos
 
					ELSE
						CONTINUE;
				END;
 
			ZmienZnak := lancuch;
		END;
 
BEGIN
	CLRSCR;
 
	WRITE('Wprowadź łańcuch znaków: ');
	READLN(lancuch);
 
	WRITELN;
 
	WRITELN('Wynik: ', ZmienZnak(lancuch, ' ', '_'));
 
	REPEAT UNTIL KEYPRESSED;
END.

Przy pomocy funkcji ZmienZnak zmieniam wszystkie wystąpienia znaku spacji na znak podkreślenia w podanym przez użytkownika łańcuchu znaków.

Zadanie 5

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43

PROGRAM lista7_zad5(INPUT, OUTPUT);
 
USES
	CRT;
 
VAR
	lancuch : STRING;
	znak : CHAR;
 
	FUNCTION ZliczZnak(str : STRING; zn : CHAR) : INTEGER;
		VAR
			x, ilosc : INTEGER;
 
		BEGIN
			ilosc := 0;
 
			FOR x := 1 TO LENGTH(lancuch) DO
				BEGIN
					IF lancuch[x] = zn THEN
						ilosc := ilosc + 1
 
					ELSE
						CONTINUE;
				END;
 
			ZliczZnak := ilosc;
		END;
 
BEGIN
	CLRSCR;
 
	WRITE('Wprowadź łańcuch znaków: ');
	READLN(lancuch);
 
	WRITE('Szukany znak: ');
	READLN(znak);
 
	WRITELN;
 
	WRITELN('Wynik: ', ZliczZnak(lancuch, znak));
 
	REPEAT UNTIL KEYPRESSED;
END.

Przy pomocy funkcji ZliczZnak zliczam ilość wystąpień danego znaku w podanym przez użytkownika łańcuchu znaków.

Zadanie 6

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45

PROGRAM lista7_zad6(INPUT, OUTPUT);
 
USES
	CRT;
 
VAR
	lancuch : STRING;
 
	FUNCTION UsunZnak(str : STRING; zn : CHAR) : STRING;
		VAR
			x, ilosc, index : INTEGER;
 
		BEGIN
			ilosc := 0;
 
			FOR x := 1 TO LENGTH(str) DO
				BEGIN
					IF str[x] = zn THEN
						ilosc := ilosc + 1
 
					ELSE
						CONTINUE;
				END;
 
			FOR x := 1 TO ilosc DO
				BEGIN
					index := POS(zn, str);
					DELETE(str, index, 1);
				END;
 
			UsunZnak := str;
		END;
 
BEGIN
	CLRSCR;
 
	WRITE('Wprowadź łańcuch znaków: ');
	READLN(lancuch);
 
	WRITELN;
 
	WRITELN('Wynik: ', UsunZnak(lancuch, ' '));
 
	REPEAT UNTIL KEYPRESSED;
END.

Przy pomocy funkcji UsunZnak usuwam wszystkie wystąpienia znaku spacji w podanym przez użytkownika łańcuchu znaków.

Zadanie 7

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50

PROGRAM lista7_zad7(INPUT, OUTPUT);
 
USES
	CRT;
 
VAR
	lancuch : STRING;
 
	FUNCTION ZliczWyrazy(str : STRING) : INTEGER;
		VAR
			x, ilosc : INTEGER;
			zbior : SET OF CHAR;
 
		BEGIN
			zbior := ['A'..'Z', 'a'..'z'];
			ilosc := 0;
 
			FOR x := 1 TO LENGTH(lancuch) DO
				BEGIN
					IF NOT (lancuch[x] IN zbior) AND (lancuch[x + 1] IN zbior) AND (x + 1 < = LENGTH(lancuch)) THEN
						ilosc := ilosc + 1
 
					ELSE
						CONTINUE;
				END;
 
			IF NOT (lancuch[1] IN zbior) THEN
				ilosc := ilosc - 1
 
			ELSE IF LENGTH(lancuch) = 0 THEN
				ilosc := ilosc - 1
 
			ELSE
				ilosc := ilosc;
 
			ZliczWyrazy := ilosc + 1;
		END;
 
BEGIN
	CLRSCR;
 
	WRITE('Wprowadź łańcuch znaków: ');
	READLN(lancuch);
 
	WRITELN;
 
	WRITELN('Wynik: ', ZliczWyrazy(lancuch));
 
	REPEAT UNTIL KEYPRESSED;
END.

Przy pomocy funkcji ZliczWyrazy wyznaczam ilość wyrazów w łańcuchu znaków podanym przez użytkownika. W tym celu należy cały łańcuch przeanalizować względem zbioru dużych i małych liter.

Zadanie 8

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41

PROGRAM lista7_zad8(INPUT, OUTPUT);
 
USES
	CRT;
 
VAR
	lancuch : STRING;
 
	PROCEDURE RozdzielWyrazy(str : STRING);
		VAR
			x : INTEGER;
			zbior : SET OF CHAR;
 
		BEGIN
			zbior := ['A'..'Z', 'a'..'z'];
 
			FOR x := 1 TO LENGTH(lancuch) DO
				BEGIN
					IF lancuch[x] IN zbior THEN
						WRITE(lancuch[x])
 
					ELSE IF (lancuch[x - 1] IN zbior) AND NOT (lancuch[x] IN zbior) THEN
						WRITELN
 
					ELSE
						CONTINUE;
				END;
		END;
 
BEGIN
	CLRSCR;
 
	WRITE('Wprowadź łańcuch znaków: ');
	READLN(lancuch);
 
	WRITELN;
 
	RozdzielWyrazy(lancuch);
 
	REPEAT UNTIL KEYPRESSED;
END.

Procedura RozdzielWyrazy ma za zadanie wypisać każde sowo w odzielnym wierszu, bez względu na budowę wprowadzonego wczęsniej łańcucha znaków

Zadanie 9

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53

PROGRAM lista7_zad9(INPUT, OUTPUT);
 
USES
	CRT;
 
VAR
	lancuch : STRING;
 
	FUNCTION MaxWyraz(str : STRING) : STRING;
		VAR
			x, licznik, max, index : INTEGER;
			zbior : SET OF CHAR;
 
		BEGIN
			licznik := 0;
			max := 0;
			zbior := ['A'..'Z', 'a'..'z'];
 
			FOR x := 1 TO LENGTH(str) DO
				BEGIN
					IF NOT (str[x] in zbior) THEN
						licznik := 0
 
					ELSE
						BEGIN
							licznik := licznik + 1;
 
							IF max < licznik THEN
								BEGIN
									max := licznik;
									index := x;
								END
 
							ELSE
								CONTINUE;
						END;
				END;
 
			MaxWyraz := COPY(str, (index - max + 1), max);
		END;
 
BEGIN
	CLRSCR;
 
	WRITE('Podaj łańcuch znaków: ');
	READLN(lancuch);
 
	WRITELN;
 
	WRITELN('Wynik: ', MaxWyraz(lancuch));
 
	REPEAT UNTIL KEYPRESSED;
END.

Przy pomocy funkcji MaxWyraz wyznaczam najdłuższy wyraz w podanym przez użytkownika łańcuchu znaków. Algorytm zlicza tylko i wyłącznie znaki będące dużymi i małymi literami, wyznaczając w późniejszym etapie maksymalną wartość. W międzyczasie ustalamy położenie wyrazu w całym łańcuchu i przy pomocy funkcji COPY wyciągamy właściwy fragment.

Zadanie 10

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32

PROGRAM lista7_zad10(INPUT, OUTPUT);
 
USES
	CRT;
 
VAR
	lancuch : STRING;
 
	FUNCTION DuplikujWyraz(str : STRING) : STRING;
		VAR
			x : INTEGER;
			duplistr : STRING;
 
		BEGIN
			FOR x := 1 TO LENGTH(str) DO
				duplistr := duplistr + str[x] + str[x];
 
			DuplikujWyraz := duplistr;
		END;
 
BEGIN
	CLRSCR;
 
	WRITE('Podaj łańcuch znaków: ');
	READLN(lancuch);
 
	WRITELN;
 
	WRITELN('Wynik: ', DuplikujWyraz(lancuch));
 
	REPEAT UNTIL KEYPRESSED;
END.

Przy pomocy funkcji DuplikujWyraz podwajam wystąpienie każdego znaku w podanym przez użytkownika wyrazie.

Zadanie 11

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40

PROGRAM lista7_zad11(INPUT, OUTPUT);
 
USES
	CRT;
 
VAR
	lancuch, sublancuch : STRING;
 
	FUNCTION UsunSubLancuch(str, substr : STRING) : STRING;	
		VAR
			index, dlugosc : INTEGER;
 
		BEGIN
			index := POS(substr, str);
			dlugosc := LENGTH(substr);
 
			DELETE(str, index, dlugosc);
 
			IF index > 0 THEN
				UsunSubLancuch := UsunSubLancuch(str, substr)
 
			ELSE
				UsunSubLancuch := str;
		END;
 
BEGIN
	CLRSCR;
 
	WRITE('Podaj łańcuch znaków: ');
	READLN(lancuch);
 
	WRITE('Podaj podłańcuch znaków: ');
	READLN(sublancuch);
 
	WRITELN;
 
	WRITELN('Wynik: ', UsunSubLancuch(lancuch, sublancuch));
 
	REPEAT UNTIL KEYPRESSED;
END.

Przy pomocy funkcji UsunSubLancuch usuwam wszystkie wystąpienia danego podłańcucha w głównym łańcuchu znaków. Tym razem postanowiłem nie korzystać z pętli w celu analizy obu stringów, a oddać tą część pracy w ręce gotowych funkcji: POS, DELETE czy LENGTH.

Zadanie 12

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47

PROGRAM lista7_zad12(INPUT, OUTPUT);
 
USES
	CRT;
 
VAR
	lancuch, sublancuch, zastepczy : STRING;
 
	FUNCTION ZamienWyrazy(str, substr, exstr : STRING) : STRING;
		VAR
			x, index, dlugosc : INTEGER;
			newstr : STRING;
 
		BEGIN
			index := POS(substr, str);
			newstr := str;
 
			IF index = 0 THEN
				ZamienWyrazy := newstr
 
			ELSE
				BEGIN
					dlugosc := LENGTH(substr) + index - 1;
					newstr := CONCAT(COPY(str, 1, index - 1), exstr, COPY(str, dlugosc + 1, LENGTH(str) - index));
 
					ZamienWyrazy := ZamienWyrazy(newstr, substr, exstr);
				END;
		END;
 
BEGIN
	CLRSCR;
 
	WRITE('Wpisz łańcuch znaków: ');
	READLN(lancuch);
 
	WRITE('Podaj szukany podłańcuch znaków: ');
	READLN(sublancuch);
 
	WRITE('Podaj zastępczy łańcuch znaków: ');
	READLN(zastepczy);
 
	WRITELN;
 
	WRITELN('Wynik: ', ZamienWyrazy(lancuch, sublancuch, zastepczy));
 
	REPEAT UNTIL KEYPRESSED;
END.

Zadanie podobne do powyższego, z tym że tutaj dokonujemy zamiany we wszystkich miejscach szukanego podłańcucha na nowy ciąg znaków (o nie znanym rozmiarze). Cały "pic" polega na umiejętnym wykorzystaniu wspomnianych już funkcji operujących na stringach: String handling i rekurencji.

Wszystkie zadania z tej lekcji można pobrać: tutaj.

Categories: Free Pascal, UwB Tags:
  1. Ula
    Styczeń 4th, 2010 at 23:33 | #1
    Odpowiedz | Cytuj

    A ja dalej czekam na relacje z konferencji, chociaż teraz juz po ptokach chyba…

  2. Katharsis
    Styczeń 5th, 2010 at 07:09 | #2
    Odpowiedz | Cytuj

    Nigdy nie jest za późno! Potrzebuję motywacji, którą aktualnie zżera choroba. Z czasem i relacja się pojawi, na razie warto zadowolić się dostępnymi już filmami z konferencji:

    http://rupy.blip.tv/

  3. Ula
    Styczeń 5th, 2010 at 21:53 | #3
    Odpowiedz | Cytuj

    No nie wiem czy jak napiszesz na wakacjach Żaba, to ktoś to będzie chciał jeszcze czytać :). Ciebie na filmach nie ma, to nie warto oglądać.

  1. Brak jeszcze trackbacków
Kod (wymagane)